diff options
Diffstat (limited to 'erts/emulator')
56 files changed, 2938 insertions, 571 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 12148ad9c7..3a5cfddc30 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -779,6 +779,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \ $(OBJDIR)/erl_msacc.o +LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o + ifeq ($(TARGET),win32) DRV_OBJS = \ $(OBJDIR)/registry_drv.o \ @@ -885,7 +887,7 @@ ifdef HIPE_ENABLED EXTRA_BASE_OBJS += $(HIPE_OBJS) endif -BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) +BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS) before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 5d471d168b..74c9d3ee53 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -974,7 +974,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt) if (pbt == 0) { /* First call of process to instrumented function */ pbt = Alloc(sizeof(process_breakpoint_time_t)); - (void) ERTS_PROC_SET_CALL_TIME(c_p, ERTS_PROC_LOCK_MAIN, pbt); + (void) ERTS_PROC_SET_CALL_TIME(c_p, pbt); } else { ASSERT(pbt->pc); /* add time to previous code */ @@ -1598,9 +1598,7 @@ bp_time_unref(BpDataTime* bdt) h_p = erts_pid2proc(NULL, 0, item->pid, ERTS_PROC_LOCK_MAIN); if (h_p) { - pbt = ERTS_PROC_SET_CALL_TIME(h_p, - ERTS_PROC_LOCK_MAIN, - NULL); + pbt = ERTS_PROC_SET_CALL_TIME(h_p, NULL); if (pbt) { Free(pbt); } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a390422040..09a41f2b56 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4102,7 +4102,7 @@ do { \ StoreBifResult(1, result); } - OpCase(i_bs_put_utf16_jIs): { + OpCase(bs_put_utf16_jIs): { Eterm arg; GetArg1(2, arg); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index f115df935f..a98900460e 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1548,7 +1548,7 @@ read_literal_table(LoaderState* stp) erts_factory_heap_frag_init(&factory, new_literal_fragment(heap_size)); factory.alloc_type = ERTS_ALC_T_PREPARED_CODE; - val = erts_decode_ext(&factory, &p); + val = erts_decode_ext(&factory, &p, 0); if (is_non_value(val)) { LoadError1(stp, "literal %d: bad external format", i); @@ -1559,7 +1559,7 @@ read_literal_table(LoaderState* stp) } else { erts_factory_dummy_init(&factory); - val = erts_decode_ext(&factory, &p); + val = erts_decode_ext(&factory, &p, 0); if (is_non_value(val)) { LoadError1(stp, "literal %d: bad external format", i); } @@ -2028,42 +2028,47 @@ load_code(LoaderState* stp) ASSERT(arity == last_op->arity); do_transform: - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - + ASSERT(stp->genop != NULL); if (gen_opc[stp->genop->op].transform != -1) { - int need; - tmp_op = stp->genop; - - for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) { - if (tmp_op == NULL) { - goto get_next_instr; - } - tmp_op = tmp_op->next; + if (stp->genop->next == NULL) { + /* + * Simple heuristic: Most transformations requires + * at least two instructions, so make sure that + * there are. That will reduce the number of + * TE_SHORT_WINDOWs. + */ + goto get_next_instr; } switch (transform_engine(stp)) { case TE_FAIL: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation found. stp->genop != NULL and + * last_op_next is still valid. Go ahead and load + * the instruction. + */ break; case TE_OK: + /* + * Some transformation was applied. last_op_next is + * no longer valid and stp->genop may be NULL. + * Try to transform again. + */ + if (stp->genop == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } last_op_next = NULL; - last_op = NULL; goto do_transform; case TE_SHORT_WINDOW: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation applied. stp->genop != NULL and + * last_op_next is still valid. Fetch a new instruction + * before trying the transformation again. + */ goto get_next_instr; } } - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - /* * From the collected generic instruction, find the specific * instruction. @@ -2584,7 +2589,10 @@ load_code(LoaderState* stp) { GenOp* next = stp->genop->next; FREE_GENOP(stp, stp->genop); - stp->genop = next; + if ((stp->genop = next) == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } goto do_transform; } } @@ -2728,10 +2736,10 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) } static int -same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label) +is_killed_apply(LoaderState* stp, GenOpArg Reg, GenOpArg Live) { - return Target.type = TAG_f && Label.type == TAG_u && - Target.val == Label.val; + return Reg.type == TAG_x && Live.type == TAG_u && + Live.val+2 <= Reg.val; } static int @@ -4798,31 +4806,25 @@ transform_engine(LoaderState* st) Uint op; int ap; /* Current argument. */ Uint* restart; /* Where to restart if current match fails. */ - GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ - GenOpArg* var = def_vars; - int num_vars = 0; + GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ + GenOpArg* rest_args = NULL; + int num_rest_args = 0; int i; /* General index. */ Uint mask; GenOp* instr; + GenOp* first = st->genop; + GenOp* keep = NULL; Uint* pc; - int rval; static Uint restart_fail[1] = {TOP_fail}; - ASSERT(gen_opc[st->genop->op].transform != -1); - pc = op_transform + gen_opc[st->genop->op].transform; - restart = pc; + ASSERT(gen_opc[first->op].transform != -1); + restart = op_transform + gen_opc[first->op].transform; restart: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - var = def_vars; - } ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - instr = st->genop; - -#define RETURN(r) rval = (r); goto do_return; + instr = first; #ifdef DEBUG restart = NULL; @@ -4840,7 +4842,7 @@ transform_engine(LoaderState* st) * We'll need at least one more instruction to decide whether * this combination matches or not. */ - RETURN(TE_SHORT_WINDOW); + return TE_SHORT_WINDOW; } if (*pc++ != instr->op) goto restart; @@ -5002,19 +5004,9 @@ transform_engine(LoaderState* st) #if defined(TOP_rest_args) case TOP_rest_args: { - int n = *pc++; int formal_arity = gen_opc[instr->op].arity; - int j = formal_arity; - - num_vars = n + (instr->arity - formal_arity); - var = erts_alloc(ERTS_ALC_T_LOADER_TMP, - num_vars * sizeof(GenOpArg)); - for (i = 0; i < n; i++) { - var[i] = def_vars[i]; - } - while (i < num_vars) { - var[i++] = instr->a[j++]; - } + num_rest_args = instr->arity - formal_arity; + rest_args = instr->a + formal_arity; } break; #endif @@ -5023,21 +5015,22 @@ transform_engine(LoaderState* st) break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } + keep = instr; + st->genop = instr; #ifdef DEBUG instr = 0; #endif break; - +#if defined(TOP_keep) + case TOP_keep: + /* Keep the current instruction unchanged. */ + keep = instr; + st->genop = instr; +#ifdef DEBUG + instr = 0; +#endif + break; +#endif #if defined(TOP_call_end) case TOP_call_end: { @@ -5062,22 +5055,19 @@ transform_engine(LoaderState* st) lastp = &((*lastp)->next); } - instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } - *lastp = st->genop; + keep = instr->next; /* The next_instr was optimized away. */ + *lastp = keep; st->genop = new_instr; } - RETURN(TE_OK); + /* FALLTHROUGH */ #endif + case TOP_end: + while (first != keep) { + GenOp* next = first->next; + FREE_GENOP(st, first); + first = next; + } + return TE_OK; case TOP_new_instr: /* * Note that the instructions are generated in reverse order. @@ -5089,6 +5079,12 @@ transform_engine(LoaderState* st) instr->arity = gen_opc[op].arity; ap = 0; break; +#ifdef TOP_rename + case TOP_rename: + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + return TE_OK; +#endif case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -5108,14 +5104,10 @@ transform_engine(LoaderState* st) #if defined(TOP_store_rest_args) case TOP_store_rest_args: { - int n = *pc++; - int num_extra = num_vars - n; - - ASSERT(n <= num_vars); - GENOP_ARITY(instr, instr->arity+num_extra); + GENOP_ARITY(instr, instr->arity+num_rest_args); memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); - memcpy(instr->a+ap, var+n, num_extra*sizeof(GenOpArg)); - ap += num_extra; + memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg)); + ap += num_rest_args; } break; #endif @@ -5127,21 +5119,12 @@ transform_engine(LoaderState* st) case TOP_try_me_else_fail: restart = restart_fail; break; - case TOP_end: - RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL); + return TE_FAIL; default: ASSERT(0); } } -#undef RETURN - - do_return: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - } - return rval; } static void @@ -5719,7 +5702,7 @@ attributes_for_module(Process* p, /* Process whose heap to use. */ if (ext != NULL) { ErtsHeapFactory factory; erts_factory_proc_prealloc_init(&factory, p, code_hdr->attr_size_on_heap); - result = erts_decode_ext(&factory, &ext); + result = erts_decode_ext(&factory, &ext, 0); if (is_value(result)) { erts_factory_close(&factory); } @@ -5742,7 +5725,7 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ if (ext != NULL) { ErtsHeapFactory factory; erts_factory_proc_prealloc_init(&factory, p, code_hdr->compile_size_on_heap); - result = erts_decode_ext(&factory, &ext); + result = erts_decode_ext(&factory, &ext, 0); if (is_value(result)) { erts_factory_close(&factory); } diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index 22ab71c868..68f4b96893 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -33,7 +33,6 @@ typedef struct gen_op_entry { int specific; int num_specific; int transform; - int min_window; } GenOpEntry; extern GenOpEntry gen_opc[]; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 37bb28c6f8..75ccaa6dd9 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1567,7 +1567,7 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, scb->n = 0; } - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, ERTS_PROC_LOCK_MAIN, scb); + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); if (!scb) old_value = make_small(0); @@ -1595,9 +1595,7 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) if (is_not_atom(BIF_ARG_2)) { goto error; } - old_value = erts_proc_set_error_handler(BIF_P, - ERTS_PROC_LOCK_MAIN, - BIF_ARG_2); + old_value = erts_proc_set_error_handler(BIF_P, BIF_ARG_2); BIF_RET(old_value); } else if (BIF_ARG_1 == am_priority) { @@ -1622,14 +1620,17 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) * true. For more info, see implementation of * erts_send_exit_signal(). */ + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_XSIG_SEND); if (trap_exit) state = erts_smp_atomic32_read_bor_mb(&BIF_P->state, ERTS_PSFLG_TRAP_EXIT); else state = erts_smp_atomic32_read_band_mb(&BIF_P->state, ~ERTS_PSFLG_TRAP_EXIT); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_XSIG_SEND); + #ifdef ERTS_SMP - if (ERTS_PROC_PENDING_EXIT(BIF_P)) { + if (state & ERTS_PSFLG_PENDING_EXIT) { erts_handle_pending_exit(BIF_P, ERTS_PROC_LOCK_MAIN); ERTS_BIF_EXITED(BIF_P); } diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 490e0c0915..9cbe00d719 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1949,7 +1949,7 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) va_start(argp, n); size = va_arg(argp, Uint); va_end(argp); - erts_exit(1, + erts_exit(ERTS_DUMP_EXIT, "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", allctr_str, op, size, t_str); break; diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 71e4713624..ee2013bd93 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -235,9 +235,9 @@ void *erts_alloc(ErtsAlcType_t type, Uint size) void *res; ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( - ERTS_ALC_T2N(type), - erts_allctrs[ERTS_ALC_T2A(type)].extra, - size); + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + size); if (!res) erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); ERTS_MSACC_POP_STATE_X(); @@ -564,5 +564,3 @@ NAME##_free(TYPE *p) \ #undef ERTS_ALC_ATTRIBUTES #endif /* #ifndef ERL_ALLOC_H__ */ - - diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 5e7dd7cce8..6e682019ba 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -52,6 +52,7 @@ #ifdef ERTS_ENABLE_LOCK_COUNT #include "erl_lock_count.h" #endif +#include "lttng-wrapper.h" #if defined(ERTS_ALLOC_UTIL_HARD_DEBUG) && defined(__GNUC__) #warning "* * * * * * * * * *" @@ -3125,6 +3126,7 @@ cpool_insert(Allctr_t *allctr, Carrier_t *crr) erts_smp_atomic_set_wb(&crr->allctr, ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL); + LTTNG3(carrier_pool_put, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, CARRIER_SZ(crr)); } static void @@ -3240,6 +3242,7 @@ cpool_fetch(Allctr_t *allctr, UWord size) first_old_traitor = allctr->cpool.traitor_list.next; cpool_entrance = NULL; + LTTNG3(carrier_pool_get, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, (unsigned long)size); /* * Search my own pooled_list, * i.e my abandoned carriers that were in the pool last time I checked. @@ -3925,6 +3928,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) } +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(carrier_create)) { + lttng_decl_carrier_stats(mbc_stats); + lttng_decl_carrier_stats(sbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats); + LTTNG5(carrier_create, + ERTS_ALC_A2AD(allctr->alloc_no), + allctr->ix, + crr_sz, + mbc_stats, + sbc_stats); + } +#endif + DEBUG_SAVE_ALIGNMENT(crr); return blk; } @@ -4148,6 +4166,21 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) allctr->remove_mbc(allctr, crr); } +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(carrier_destroy)) { + lttng_decl_carrier_stats(mbc_stats); + lttng_decl_carrier_stats(sbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats); + LTTNG5(carrier_destroy, + ERTS_ALC_A2AD(allctr->alloc_no), + allctr->ix, + crr_sz, + mbc_stats, + sbc_stats); + } +#endif + #ifdef ERTS_SMP schedule_dealloc_carrier(allctr, crr); #else diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index b7d717ed23..afdff1a71e 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -30,6 +30,7 @@ #endif #include "erl_mseg.h" +#include "lttng-wrapper.h" #define ERTS_AU_PREF_ALLOC_BITS 11 #define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS) @@ -417,6 +418,18 @@ typedef struct { } blocks; } CarriersStats_t; +#ifdef USE_LTTNG_VM_TRACEPOINTS +#define LTTNG_CARRIER_STATS_TO_LTTNG_STATS(CSP, LSP) \ + do { \ + (LSP)->carriers.size = (CSP)->curr.norm.mseg.size \ + + (CSP)->curr.norm.sys_alloc.size; \ + (LSP)->carriers.no = (CSP)->curr.norm.mseg.no \ + + (CSP)->curr.norm.sys_alloc.no; \ + (LSP)->blocks.size = (CSP)->blocks.curr.size; \ + (LSP)->blocks.no = (CSP)->blocks.curr.no; \ + } while (0) +#endif + #ifdef ERTS_SMP typedef union ErtsAllctrDDBlock_t_ ErtsAllctrDDBlock_t; diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index cdeeb5281b..69240f7886 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -28,6 +28,7 @@ #include "erl_thr_queue.h" #include "erl_async.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #define ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ 20 @@ -281,6 +282,13 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) #endif erts_thr_q_enqueue(&q->thr_q, a); +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(aio_pool_add)) { + lttng_decl_portbuf(port_str); + lttng_portid_to_str(a->port, port_str); + LTTNG2(aio_pool_add, port_str, -1); + } +#endif #ifdef USE_VM_PROBES if (DTRACE_ENABLED(aio_pool_add)) { DTRACE_CHARBUF(port_str, 16); @@ -317,6 +325,14 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, if (saved_fin_deq) erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq); #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(aio_pool_get)) { + lttng_decl_portbuf(port_str); + int length = erts_thr_q_length_dirty(q); + lttng_portid_to_str(a->port, port_str); + LTTNG2(aio_pool_get, port_str, length); + } +#endif #ifdef USE_VM_PROBES if (DTRACE_ENABLED(aio_pool_get)) { DTRACE_CHARBUF(port_str, 16); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index f006856b6a..b526eda41d 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -48,6 +48,7 @@ #include "erl_version.h" #include "erl_bif_unique.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #ifdef ERTS_SMP #define DDLL_SMP 1 @@ -1619,6 +1620,7 @@ static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name) if (q->finish) { int fpe_was_unmasked = erts_block_fpe(); DTRACE1(driver_finish, q->name); + LTTNG1(driver_finish, q->name); (*(q->finish))(); erts_unblock_fpe(fpe_was_unmasked); } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 8c748c9bf7..0b2c26a548 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -126,6 +126,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef ERTS_FRMPTR " [frame-pointer]" #endif +#ifdef USE_LTTNG + " [lttng]" +#endif #ifdef USE_DTRACE " [dtrace]" #endif @@ -1480,7 +1483,7 @@ process_info_aux(Process *BIF_P, } case am_last_calls: { - struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(BIF_P); + struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp); if (!scb) { hp = HAlloc(BIF_P, 3); res = am_false; @@ -2748,6 +2751,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #elif defined(USE_SYSTEMTAP) DECL_AM(systemtap); BIF_RET(AM_systemtap); +#elif defined(USE_LTTNG) + DECL_AM(lttng); + BIF_RET(AM_lttng); #else BIF_RET(am_none); #endif diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c index c4a39b8897..c9c8561f64 100644 --- a/erts/emulator/beam/erl_bif_unique.c +++ b/erts/emulator/beam/erl_bif_unique.c @@ -266,17 +266,19 @@ static ERTS_INLINE Eterm unique_integer_bif(Process *c_p, int positive) } Uint -erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int positive) { Uint sz; - bld_unique_integer_term(NULL, &sz, val[0], val[1], 0); + bld_unique_integer_term(NULL, &sz, val[0], val[1], positive); return sz; } Eterm -erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]) +erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int positive) { - return bld_unique_integer_term(hpp, NULL, val[0], val[1], 0); + return bld_unique_integer_term(hpp, NULL, val[0], val[1], positive); } void @@ -426,16 +428,16 @@ erts_raw_get_unique_monotonic_integer(void) } Uint -erts_raw_unique_monotonic_integer_heap_size(Sint64 raw) +erts_raw_unique_monotonic_integer_heap_size(Sint64 raw, int positive) { - return get_unique_monotonic_integer_heap_size(raw, 0); + return get_unique_monotonic_integer_heap_size(raw, positive); } Eterm -erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw) +erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw, int positive) { - Uint hsz = get_unique_monotonic_integer_heap_size(raw, 0); - Eterm res = make_unique_monotonic_integer_value(*hpp, hsz, raw, 0); + Uint hsz = get_unique_monotonic_integer_heap_size(raw, positive); + Eterm res = make_unique_monotonic_integer_value(*hpp, hsz, raw, positive); *hpp += hsz; return res; } diff --git a/erts/emulator/beam/erl_bif_unique.h b/erts/emulator/beam/erl_bif_unique.h index 37d5d91c39..94fd6163f2 100644 --- a/erts/emulator/beam/erl_bif_unique.h +++ b/erts/emulator/beam/erl_bif_unique.h @@ -41,8 +41,9 @@ void erts_make_ref_in_array(Uint32 ref[ERTS_MAX_REF_NUMBERS]); * not necessarily correspond to the end result. */ Sint64 erts_raw_get_unique_monotonic_integer(void); -Uint erts_raw_unique_monotonic_integer_heap_size(Sint64 raw); -Eterm erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw); +Uint erts_raw_unique_monotonic_integer_heap_size(Sint64 raw, int positive); +Eterm erts_raw_make_unique_monotonic_integer_value(Eterm **hpp, Sint64 raw, + int positive); Sint64 erts_get_min_unique_monotonic_integer(void); @@ -53,8 +54,11 @@ Eterm erts_debug_get_unique_monotonic_integer_state(Process *c_p); #define ERTS_UNIQUE_INT_RAW_VALUES 2 #define ERTS_MAX_UNIQUE_INT_HEAP_SIZE ERTS_UINT64_ARRAY_TO_BIG_MAX_HEAP_SZ(2) -Uint erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); -Eterm erts_raw_make_unique_integer(Eterm **hpp, Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); +Uint erts_raw_unique_integer_heap_size(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int positive); +Eterm erts_raw_make_unique_integer(Eterm **hpp, + Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES], + int postive); void erts_raw_get_unique_integer(Uint64 val[ERTS_UNIQUE_INT_RAW_VALUES]); Sint64 erts_get_min_unique_integer(void); diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 4b6931f848..6b747256e1 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -196,13 +196,13 @@ erts_maps_get(Eterm key, Eterm map) return &vs[i]; } } - } - - for (i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - return &vs[i]; - } - } + } else { + for (i = 0; i < n; i++) { + if (EQ(ks[i], key)) { + return &vs[i]; + } + } + } return NULL; } ASSERT(is_hashmap(map)); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 88efb2c59f..bc0a55068b 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -766,17 +766,7 @@ erts_send_message(Process* sender, utag = DT_UTAG(sender); else utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp); -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) Spreading tag (%T) with " - "message %T!\r\n",sender->common.id, utag, message); -#endif } -#endif - BM_MESSAGE_COPIED(msize); - BM_SWAP_TIMER(copy,send); - -#ifdef USE_VM_PROBES if (DTRACE_ENABLED(message_send)) { if (have_seqtrace(stoken)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken)); @@ -787,6 +777,9 @@ erts_send_message(Process* sender, msize, tok_label, tok_lastcnt, tok_serial); } #endif + BM_MESSAGE_COPIED(msize); + BM_SWAP_TIMER(copy,send); + } else { Eterm *hp; @@ -822,8 +815,10 @@ erts_send_message(Process* sender, BM_MESSAGE_COPIED(msz); BM_SWAP_TIMER(copy,send); } +#ifdef USE_VM_PROBES DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); +#endif } res = queue_message(sender, diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 8580bc2689..d3030070b7 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -209,6 +209,7 @@ static void flush_env(ErlNifEnv* env) */ static void cache_env(ErlNifEnv* env) { + env->heap_frag = MBUF(env->proc); if (env->heap_frag == NULL) { ASSERT(env->hp_end == HEAP_LIMIT(env->proc)); ASSERT(env->hp <= HEAP_TOP(env->proc)); @@ -216,10 +217,6 @@ static void cache_env(ErlNifEnv* env) env->hp = HEAP_TOP(env->proc); } else { - ASSERT(env->hp_end != HEAP_LIMIT(env->proc)); - ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size); - env->heap_frag = MBUF(env->proc); - ASSERT(env->heap_frag != NULL); env->hp = env->heap_frag->mem + env->heap_frag->used_size; env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size; } @@ -375,6 +372,29 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, return 1; } +int +enif_port_command(ErlNifEnv *env, const ErlNifPort* to_port, + ErlNifEnv *msg_env, ERL_NIF_TERM msg) +{ + + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + int scheduler = esdp ? esdp->no : 0; + Port *prt; + + if (scheduler == 0 || !env) + return 0; + + prt = erts_port_lookup(to_port->port_id, + (erts_port_synchronous_ops + ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + : ERTS_PORT_SFLGS_INVALID_LOOKUP)); + + if (!prt) + return 0; + + return erts_port_output_async(prt, env->proc->common.id, msg); +} + ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term) { Uint sz; @@ -404,12 +424,28 @@ static int is_offheap(const ErlOffHeap* oh) ErlNifPid* enif_self(ErlNifEnv* caller_env, ErlNifPid* pid) { + if (caller_env->proc->common.id == ERTS_INVALID_PID) + return NULL; pid->pid = caller_env->proc->common.id; return pid; } + int enif_get_local_pid(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPid* pid) { - return is_internal_pid(term) ? (pid->pid=term, 1) : 0; + if (is_internal_pid(term)) { + pid->pid=term; + return 1; + } + return 0; +} + +int enif_get_local_port(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPort* port) +{ + if (is_internal_port(term)) { + port->port_id=term; + return 1; + } + return 0; } int enif_is_atom(ErlNifEnv* env, ERL_NIF_TERM term) @@ -622,6 +658,68 @@ unsigned char* enif_make_new_binary(ErlNifEnv* env, size_t size, return binary_bytes(*termp); } +int enif_term_to_binary(ErlNifEnv *dst_env, ERL_NIF_TERM term, + ErlNifBinary *bin) +{ + Sint size; + byte *bp; + Binary* refbin; + + size = erts_encode_ext_size(term); + if (!enif_alloc_binary(size, bin)) + return 0; + + refbin = bin->ref_bin; + + bp = bin->data; + + erts_encode_ext(term, &bp); + + bin->size = bp - bin->data; + refbin->orig_size = bin->size; + + ASSERT(bin->data + bin->size == bp); + + return 1; +} + +size_t enif_binary_to_term(ErlNifEnv *dst_env, + const unsigned char* data, + size_t data_sz, + ERL_NIF_TERM *term, + ErlNifBinaryToTerm opts) +{ + Sint size; + ErtsHeapFactory factory; + byte *bp = (byte*) data; + + ERTS_CT_ASSERT(ERL_NIF_BIN2TERM_SAFE == ERTS_DIST_EXT_BTT_SAFE); + + if (opts & ~ERL_NIF_BIN2TERM_SAFE) { + return 0; + } + if ((size = erts_decode_ext_size(bp, data_sz)) < 0) + return 0; + + if (size > 0) { + flush_env(dst_env); + erts_factory_proc_prealloc_init(&factory, dst_env->proc, size); + } else { + erts_factory_dummy_init(&factory); + } + + *term = erts_decode_ext(&factory, &bp, (Uint32)opts); + + if (is_non_value(*term)) { + return 0; + } + erts_factory_close(&factory); + cache_env(dst_env); + + ASSERT(bp > data); + return bp - data; +} + int enif_is_identical(Eterm lhs, Eterm rhs) { return EQ(lhs,rhs); @@ -1158,6 +1256,103 @@ int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list return 1; } +int enif_is_process_alive(ErlNifEnv* env, ErlNifPid *proc) +{ + ErtsProcLocks rp_locks = 0; /* We don't need any locks, + just to check if it is alive */ + Eterm target = proc->pid; + Process* rp; + Process* c_p; + int scheduler = erts_get_scheduler_id() != 0; + + if (env != NULL) { + c_p = env->proc; + if (target == c_p->common.id) { + /* We are alive! */ + return 1; + } + } + else { +#ifdef ERTS_SMP + c_p = NULL; +#else + erts_exit(ERTS_ABORT_EXIT,"enif_is_process_alive: " + "env==NULL on non-SMP VM"); +#endif + } + + rp = (scheduler + ? erts_proc_lookup(target) + : erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, + target, rp_locks, ERTS_P2P_FLG_INC_REFC)); + if (rp == NULL) { + ASSERT(env == NULL || target != c_p->common.id); + return 0; + } else { + if (!scheduler) + erts_proc_dec_refc(rp); + return 1; + } +} + +int enif_is_port_alive(ErlNifEnv *env, ErlNifPort *port) +{ + /* only allowed if called from scheduler */ + if (erts_get_scheduler_id() == 0) + erts_exit(ERTS_ABORT_EXIT,"enif_is_port_alive: called from non-scheduler"); + + return erts_port_lookup( + port->port_id, + (erts_port_synchronous_ops + ? ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + : ERTS_PORT_SFLGS_INVALID_LOOKUP)) != NULL; +} + +ERL_NIF_TERM +enif_now_time(ErlNifEnv *env) +{ + Uint mega, sec, micro; + Eterm *hp; + get_now(&mega, &sec, µ); + hp = alloc_heap(env, 4); + return TUPLE3(hp, make_small(mega), make_small(sec), make_small(micro)); +} + +ERL_NIF_TERM +enif_cpu_time(ErlNifEnv *env) +{ +#ifdef HAVE_ERTS_NOW_CPU + Uint mega, sec, micro; + Eterm *hp; + erts_get_now_cpu(&mega, &sec, µ); + hp = alloc_heap(env, 4); + return TUPLE3(hp, make_small(mega), make_small(sec), make_small(micro)); +#else + return enif_make_badarg(env); +#endif +} + +ERL_NIF_TERM +enif_make_unique_integer(ErlNifEnv *env, ErlNifUniqueInteger properties) +{ + int monotonic = properties & ERL_NIF_UNIQUE_MONOTONIC; + int positive = properties & ERL_NIF_UNIQUE_POSITIVE; + Eterm *hp; + Uint hsz; + + if (monotonic) { + Sint64 raw_unique = erts_raw_get_unique_monotonic_integer(); + hsz = erts_raw_unique_monotonic_integer_heap_size(raw_unique, positive); + hp = alloc_heap(env, hsz); + return erts_raw_make_unique_monotonic_integer_value(&hp, raw_unique, positive); + } else { + Uint64 raw_unique[ERTS_UNIQUE_INT_RAW_VALUES]; + erts_raw_get_unique_integer(raw_unique); + hsz = erts_raw_unique_integer_heap_size(raw_unique, positive); + hp = alloc_heap(env, hsz); + return erts_raw_make_unique_integer(&hp, raw_unique, positive); + } +} ErlNifMutex* enif_mutex_create(char *name) { return erl_drv_mutex_create(name); } void enif_mutex_destroy(ErlNifMutex *mtx) { erl_drv_mutex_destroy(mtx); } @@ -1653,7 +1848,7 @@ allocate_nif_sched_data(Process* proc, int argc) ep->exp.addressv[i] = &ep->exp.code[3]; } ep->exp.code[3] = (BeamInstr) em_call_nif; - (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, ep); + (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ep); return ep; } diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index c9c8b1d0af..bc1f59bc90 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -150,7 +150,12 @@ typedef enum typedef struct { ERL_NIF_TERM pid; /* internal, may change */ -}ErlNifPid; +} ErlNifPid; + +typedef struct +{ + ERL_NIF_TERM port_id; /* internal, may change */ +}ErlNifPort; typedef ErlDrvSysInfo ErlNifSysInfo; @@ -197,6 +202,15 @@ typedef enum { ERL_NIF_MAP_ITERATOR_TAIL = ERL_NIF_MAP_ITERATOR_LAST } ErlNifMapIteratorEntry; +typedef enum { + ERL_NIF_UNIQUE_POSITIVE = (1 << 0), + ERL_NIF_UNIQUE_MONOTONIC = (1 << 1) +} ErlNifUniqueInteger; + +typedef enum { + ERL_NIF_BIN2TERM_SAFE = 0x20000000 +} ErlNifBinaryToTerm; + #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) # define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS typedef struct { diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 1448a508a2..35058afe7c 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -163,6 +163,15 @@ ERL_NIF_API_FUNC_DECL(int,enif_getenv,(const char* key, char* value, size_t* val ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_monotonic_time, (ErlNifTimeUnit)); ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_time_offset, (ErlNifTimeUnit)); ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_convert_time_unit, (ErlNifTime, ErlNifTimeUnit, ErlNifTimeUnit)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_now_time, (ErlNifEnv *env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_cpu_time, (ErlNifEnv *env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_unique_integer, (ErlNifEnv *env, ErlNifUniqueInteger properties)); +ERL_NIF_API_FUNC_DECL(int, enif_is_process_alive, (ErlNifEnv *env, ErlNifPid *pid)); +ERL_NIF_API_FUNC_DECL(int, enif_is_port_alive, (ErlNifEnv *env, ErlNifPort *port_id)); +ERL_NIF_API_FUNC_DECL(int, enif_get_local_port, (ErlNifEnv* env, ERL_NIF_TERM, ErlNifPort* port_id)); +ERL_NIF_API_FUNC_DECL(int, enif_term_to_binary, (ErlNifEnv *env, ERL_NIF_TERM term, ErlNifBinary *bin)); +ERL_NIF_API_FUNC_DECL(size_t, enif_binary_to_term, (ErlNifEnv *env, const unsigned char* data, size_t sz, ERL_NIF_TERM *term, unsigned int opts)); +ERL_NIF_API_FUNC_DECL(int, enif_port_command, (ErlNifEnv *env, const ErlNifPort* to_port, ErlNifEnv *msg_env, ERL_NIF_TERM msg)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -318,6 +327,15 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_monotonic_time ERL_NIF_API_FUNC_MACRO(enif_monotonic_time) # define enif_time_offset ERL_NIF_API_FUNC_MACRO(enif_time_offset) # define enif_convert_time_unit ERL_NIF_API_FUNC_MACRO(enif_convert_time_unit) +# define enif_now_time ERL_NIF_API_FUNC_MACRO(enif_now_time) +# define enif_cpu_time ERL_NIF_API_FUNC_MACRO(enif_cpu_time) +# define enif_make_unique_integer ERL_NIF_API_FUNC_MACRO(enif_make_unique_integer) +# define enif_is_process_alive ERL_NIF_API_FUNC_MACRO(enif_is_process_alive) +# define enif_is_port_alive ERL_NIF_API_FUNC_MACRO(enif_is_port_alive) +# define enif_get_local_port ERL_NIF_API_FUNC_MACRO(enif_get_local_port) +# define enif_term_to_binary ERL_NIF_API_FUNC_MACRO(enif_term_to_binary) +# define enif_binary_to_term ERL_NIF_API_FUNC_MACRO(enif_binary_to_term) +# define enif_port_command ERL_NIF_API_FUNC_MACRO(enif_port_command) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index fa97707a87..5b06bc7fd1 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -185,7 +185,7 @@ struct _erl_drv_port { int control_flags; /* Flags for port_control() */ ErlDrvPDL port_data_lock; - ErtsPrtSD *psd; /* Port specific data */ + erts_smp_atomic_t psd; /* Port specific data */ int reds; /* Only used while executing driver callbacks */ struct { @@ -252,22 +252,51 @@ ERTS_GLB_INLINE void *erts_prtsd_set(Port *p, int ix, void *new); ERTS_GLB_INLINE void * erts_prtsd_get(Port *prt, int ix) { - return prt->psd ? prt->psd->data[ix] : NULL; + ErtsPrtSD *psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd); + if (!psd) + return NULL; + ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER; + return psd->data[ix]; } ERTS_GLB_INLINE void * erts_prtsd_set(Port *prt, int ix, void *data) { - if (prt->psd) { - void *old = prt->psd->data[ix]; - prt->psd->data[ix] = data; + ErtsPrtSD *psd, *new_psd; + void *old; + int i; + + psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd); + + if (psd) { +#ifdef ERTS_SMP +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore); +#else + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore); +#endif +#endif + old = psd->data[ix]; + psd->data[ix] = data; return old; } - else { - prt->psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD)); - prt->psd->data[ix] = data; + + if (!data) return NULL; - } + + new_psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD)); + for (i = 0; i < ERTS_PRTSD_SIZE; i++) + new_psd->data[i] = NULL; + psd = (ErtsPrtSD *) erts_smp_atomic_cmpxchg_mb(&prt->psd, + (erts_aint_t) new_psd, + (erts_aint_t) NULL); + if (psd) + erts_free(ERTS_ALC_T_PRTSD, new_psd); + else + psd = new_psd; + old = psd->data[ix]; + psd->data[ix] = data; + return old; } #endif @@ -949,6 +978,8 @@ ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *); ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *); +int erts_port_output_async(Port *, Eterm, Eterm); + /* * Signals from ports to ports. Used by sys drivers. */ diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index e85395e062..ec07d145ab 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -35,6 +35,7 @@ #include "dist.h" #include "erl_check_io.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include <stdarg.h> /* @@ -69,6 +70,18 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q #else #define DTRACE_DRIVER(PROBE_NAME, PP) do {} while(0) #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS +#define LTTNG_DRIVER(TRACEPOINT, PP) \ + if (LTTNG_ENABLED(TRACEPOINT)) { \ + lttng_decl_portbuf(port_str); \ + lttng_decl_procbuf(proc_str); \ + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(PP), proc_str); \ + lttng_port_to_str((PP), port_str); \ + LTTNG3(TRACEPOINT, proc_str, port_str, (PP)->name); \ + } +#else +#define LTTNG_DRIVER(TRACEPOINT, PP) do {} while(0) +#endif #define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \ do { \ @@ -180,10 +193,9 @@ p2p_sig_data_to_task(ErtsProc2PortSigData *sigdp) return ptp; } -ErtsProc2PortSigData * -erts_port_task_alloc_p2p_sig_data(void) +static ERTS_INLINE ErtsProc2PortSigData * +p2p_sig_data_init(ErtsPortTask *ptp) { - ErtsPortTask *ptp = port_task_alloc(); ptp->type = ERTS_PORT_TASK_PROC_SIG; ptp->u.alive.flags = ERTS_PT_FLG_SIG_DEP; @@ -194,6 +206,31 @@ erts_port_task_alloc_p2p_sig_data(void) return &ptp->u.alive.td.psig.data; } +ErtsProc2PortSigData * +erts_port_task_alloc_p2p_sig_data(void) +{ + ErtsPortTask *ptp = port_task_alloc(); + + return p2p_sig_data_init(ptp); +} + +ErtsProc2PortSigData * +erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr) +{ + ErtsPortTask *ptp = erts_alloc(ERTS_ALC_T_PORT_TASK, + sizeof(ErtsPortTask) + extra); + + *extra_ptr = ptp+1; + + return p2p_sig_data_init(ptp); +} + +void +erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp) +{ + schedule_port_task_free(p2p_sig_data_to_task(sigdp)); +} + static ERTS_INLINE Eterm task_caller(ErtsPortTask *ptp) { @@ -1728,6 +1765,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); + LTTNG_DRIVER(driver_timeout, pp); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } } @@ -1736,6 +1774,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); + LTTNG_DRIVER(driver_ready_input, pp); /* NOTE some windows drivers use ->ready_input for input and output */ (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, @@ -1747,6 +1786,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_OUTPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_output, pp); + LTTNG_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); reset_executed_io_task_handle(ptp); @@ -1756,6 +1796,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_EVENT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_event, pp); + LTTNG_DRIVER(driver_event, pp); (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event, ptp->u.alive.td.io.event_data); diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 335f7a77d5..56cef4e352 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -269,6 +269,8 @@ int erts_port_task_schedule(Eterm, void erts_port_task_free_port(Port *); int erts_port_is_scheduled(Port *); ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data(void); +ErtsProc2PortSigData *erts_port_task_alloc_p2p_sig_data_extra(size_t extra, void **extra_ptr); +void erts_port_task_free_p2p_sig_data(ErtsProc2PortSigData *sigdp); #ifdef ERTS_SMP void erts_enqueue_port(ErtsRunQueue *rq, Port *pp); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d2185c4fbc..57a7b0f288 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -43,6 +43,7 @@ #include "erl_thr_queue.h" #include "erl_async.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include "erl_ptab.h" #include "erl_bif_unique.h" #define ERTS_WANT_TIMER_WHEEL_API @@ -687,45 +688,36 @@ erts_pre_init_process(void) = "DEBUG_WAIT_COMPLETED"; #ifdef ERTS_ENABLE_LOCK_CHECK - { - int ix; - erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks - = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks - = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks + = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks + = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks - = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks - = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks + = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks + = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks - = ERTS_PSD_SCHED_ID_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks - = ERTS_PSD_SCHED_ID_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks + = ERTS_PSD_SCHED_ID_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks + = ERTS_PSD_SCHED_ID_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].get_locks - = ERTS_PSD_CALL_TIME_BP_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].set_locks - = ERTS_PSD_CALL_TIME_BP_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].get_locks + = ERTS_PSD_CALL_TIME_BP_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].set_locks + = ERTS_PSD_CALL_TIME_BP_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].get_locks - = ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks - = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS; + erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].get_locks + = ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks + = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks - = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks - = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS; - - /* Check that we have locks for all entries */ - for (ix = 0; ix < ERTS_PSD_SIZE; ix++) { - ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks); - ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks); - } - } + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks + = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks + = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS; #endif } @@ -1314,46 +1306,25 @@ erts_proclist_destroy(ErtsProcList *plp) } void * -erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data) +erts_psd_set_init(Process *p, int ix, void *data) { void *old; - ErtsProcLocks xplocks; - int refc = 0; - ErtsPSD *psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD)); + ErtsPSD *psd, *new_psd; int i; - for (i = 0; i < ERTS_PSD_SIZE; i++) - psd->data[i] = NULL; - ERTS_SMP_LC_ASSERT(plocks); - ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p)); + new_psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD)); + for (i = 0; i < ERTS_PSD_SIZE; i++) + new_psd->data[i] = NULL; - xplocks = ERTS_PROC_LOCKS_ALL; - xplocks &= ~plocks; - if (xplocks && erts_smp_proc_trylock(p, xplocks) == EBUSY) { - if (xplocks & ERTS_PROC_LOCK_MAIN) { - erts_proc_inc_refc(p); - erts_smp_proc_unlock(p, plocks); - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL); - refc = 1; - } - else { - if (plocks & ERTS_PROC_LOCKS_ALL_MINOR) - erts_smp_proc_unlock(p, plocks & ERTS_PROC_LOCKS_ALL_MINOR); - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); - } - } - if (!p->psd) - p->psd = psd; - if (xplocks) - erts_smp_proc_unlock(p, xplocks); - if (refc) - erts_proc_dec_refc(p); - ASSERT(p->psd); - if (p->psd != psd) - erts_free(ERTS_ALC_T_PSD, psd); - old = p->psd->data[ix]; - p->psd->data[ix] = data; - ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p)); + psd = (ErtsPSD *) erts_smp_atomic_cmpxchg_mb(&p->psd, + (erts_aint_t) new_psd, + (erts_aint_t) NULL); + if (psd) + erts_free(ERTS_ALC_T_PSD, new_psd); + else + psd = new_psd; + old = psd->data[ix]; + psd->data[ix] = data; return old; } @@ -3247,6 +3218,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); ASSERT(!erts_port_task_have_outstanding_io_tasks()); + LTTNG2(scheduler_poll, esdp->no, 1); erl_sys_schedule(1); /* Might give us something to do */ ERTS_MSACC_POP_STATE_M(); @@ -3370,6 +3342,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ASSERT(!erts_port_task_have_outstanding_io_tasks()); ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + LTTNG2(scheduler_poll, esdp->no, 0); erl_sys_schedule(0); @@ -9333,8 +9306,6 @@ Process *schedule(Process *p, int calls) } else { sched_out_proc: - ASSERT(!(p->flags & F_DELAY_GC)); - #ifdef ERTS_SMP ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); esdp = p->scheduler_data; @@ -9590,7 +9561,10 @@ Process *schedule(Process *p, int calls) erts_sys_schedule_interrupt(0); #endif erts_smp_runq_unlock(rq); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + LTTNG2(scheduler_poll, esdp->no, 1); + erl_sys_schedule(1); ERTS_MSACC_POP_STATE_M(); @@ -9733,12 +9707,14 @@ Process *schedule(Process *p, int calls) | ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_DIRTY_ACTIVE_SYS)) == ERTS_PSFLG_SUSPENDED)) { - if (state & ERTS_PSFLG_FREE) - erts_proc_dec_refc(p); if (proxy_p) { free_proxy_proc(proxy_p); proxy_p = NULL; } + else if (state & ERTS_PSFLG_FREE) { + /* free and not queued by proxy */ + erts_proc_dec_refc(p); + } goto pick_next_process; } state = new; @@ -9798,10 +9774,7 @@ Process *schedule(Process *p, int calls) if (erts_sched_stat.enabled) { int prio; - UWord old = ERTS_PROC_SCHED_ID(p, - (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_STATUS), - (UWord) esdp->no); + UWord old = ERTS_PROC_SCHED_ID(p, (UWord) esdp->no); int migrated = old && old != esdp->no; #ifdef ERTS_DIRTY_SCHEDULERS @@ -9895,15 +9868,24 @@ Process *schedule(Process *p, int calls) #endif if (state & ERTS_PSFLG_RUNNING_SYS) { - reds -= execute_sys_tasks(p, &state, reds); - if (reds <= 0 + /* + * GC is normally never delayed when a process + * is scheduled out, but might be when executing + * hand written beam assembly in + * prim_eval:'receive'. If GC is delayed we are + * not allowed to execute system tasks. + */ + if (!(p->flags & F_DELAY_GC)) { + reds -= execute_sys_tasks(p, &state, reds); + if (reds <= 0 #ifdef ERTS_DIRTY_SCHEDULERS - || ERTS_SCHEDULER_IS_DIRTY(esdp) - || (state & ERTS_PSFLGS_DIRTY_WORK) + || ERTS_SCHEDULER_IS_DIRTY(esdp) + || (state & ERTS_PSFLGS_DIRTY_WORK) #endif - ) { - p->fcalls = reds; - goto sched_out_proc; + ) { + p->fcalls = reds; + goto sched_out_proc; + } } ASSERT(state & ERTS_PSFLG_RUNNING_SYS); @@ -9933,7 +9915,7 @@ Process *schedule(Process *p, int calls) } if (ERTS_IS_GC_DESIRED(p)) { - if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & F_DISABLE_GC)) { + if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity); if (reds <= 0) { p->fcalls = reds; @@ -10465,7 +10447,7 @@ save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) qs->q[PRIORITY_NORMAL] = NULL; qs->q[PRIORITY_LOW] = NULL; qs->q[prio] = st; - (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, ERTS_PROC_LOCK_MAIN, qs); + (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, qs); } else { if (!qs->q[prio]) { @@ -10612,7 +10594,7 @@ erts_set_gc_state(Process *c_p, int enable) erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); - (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, ERTS_PROC_LOCK_MAIN, NULL); + (void) ERTS_PROC_SET_DELAYED_GC_TASK_QS(c_p, NULL); if (dgc_tsk_qs) proc_sys_task_queues_free(dgc_tsk_qs); @@ -11098,7 +11080,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->mbuf = NULL; p->msg_frag = NULL; p->mbuf_sz = 0; - p->psd = NULL; + erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL); p->dictionary = NULL; p->seq_trace_lastcnt = 0; p->seq_trace_clock = 0; @@ -11267,7 +11249,7 @@ void erts_init_empty_process(Process *p) p->mbuf = NULL; p->msg_frag = NULL; p->mbuf_sz = 0; - p->psd = NULL; + erts_smp_atomic_init_nob(&p->psd, (erts_aint_t) NULL); ERTS_P_MONITORS(p) = NULL; ERTS_P_LINKS(p) = NULL; /* List of links */ p->nodes_monitors = NULL; @@ -11437,14 +11419,17 @@ static void delete_process(Process* p) { Eterm *heap; + ErtsPSD *psd; VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id)); VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); /* Cleanup psd */ - if (p->psd) - erts_free(ERTS_ALC_T_PSD, p->psd); + psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); + + if (psd) + erts_free(ERTS_ALC_T_PSD, psd); /* Clean binaries and funs */ erts_cleanup_offheap(&p->off_heap); @@ -12523,9 +12508,9 @@ erts_continue_exit_process(Process *p) } dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL; - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL); - pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL); - nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, ERTS_PROC_LOCKS_ALL, NULL); + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + pbt = ERTS_PROC_SET_CALL_TIME(p, NULL); + nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); #ifdef BM_COUNTERS diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index c88bd7056c..c07337b325 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -818,8 +818,8 @@ typedef struct { #define ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ((ErtsProcLocks) 0) +#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ((ErtsProcLocks) 0) #define ERTS_PSD_SCHED_ID_GET_LOCKS ERTS_PROC_LOCK_STATUS #define ERTS_PSD_SCHED_ID_SET_LOCKS ERTS_PROC_LOCK_STATUS @@ -830,8 +830,8 @@ typedef struct { #define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ((ErtsProcLocks) 0) +#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ((ErtsProcLocks) 0) typedef struct { ErtsProcLocks get_locks; @@ -1026,7 +1026,7 @@ struct process { ErlHeapFragment* live_hf_end; ErtsMessage *msg_frag; /* Pointer to message fragment list */ Uint mbuf_sz; /* Total size of heap fragments and message fragments */ - ErtsPSD *psd; /* Rarely used process specific data */ + erts_smp_atomic_t psd; /* Rarely used process specific data */ Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */ Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */ @@ -1903,18 +1903,19 @@ do { \ #define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L) #endif -void *erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data); +void *erts_psd_set_init(Process *p, int ix, void *data); ERTS_GLB_INLINE void * erts_psd_get(Process *p, int ix); ERTS_GLB_INLINE void * -erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *new); +erts_psd_set(Process *p, int ix, void *new); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void * erts_psd_get(Process *p, int ix) { + ErtsPSD *psd; #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks) @@ -1925,17 +1926,19 @@ erts_psd_get(Process *p, int ix) || erts_thr_progress_is_blocking()); } #endif + + psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); - return p->psd ? p->psd->data[ix] : NULL; + if (!psd) + return NULL; + ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER; + return psd->data[ix]; } - -/* - * NOTE: erts_psd_set() might release and reacquire locks on 'p'. - */ ERTS_GLB_INLINE void * -erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) +erts_psd_set(Process *p, int ix, void *data) { + ErtsPSD *psd; #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks) @@ -1946,50 +1949,56 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) || erts_thr_progress_is_blocking()); } #endif + psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); - if (p->psd) { - void *old = p->psd->data[ix]; - p->psd->data[ix] = data; + if (psd) { + void *old; +#ifdef ERTS_SMP +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_MEMBAR(ETHR_LoadStore|ETHR_StoreStore); +#else + ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore|ETHR_StoreStore); +#endif +#endif + old = psd->data[ix]; + psd->data[ix] = data; return old; } - else { - if (!data) - return NULL; - else - return erts_psd_set_init(p, plocks, ix, data); - } + + if (!data) + return NULL; + + return erts_psd_set_init(p, ix, data); } #endif -#define ERTS_PROC_SCHED_ID(P, L, ID) \ - ((UWord) erts_psd_set((P), (L), ERTS_PSD_SCHED_ID, (void *) (ID))) +#define ERTS_PROC_SCHED_ID(P, ID) \ + ((UWord) erts_psd_set((P), ERTS_PSD_SCHED_ID, (void *) (ID))) #define ERTS_PROC_GET_SAVED_CALLS_BUF(P) \ ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SAVED_CALLS_BUF)) -#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, L, SCB) \ - ((struct saved_calls *) erts_psd_set((P), (L), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB))) +#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, SCB) \ + ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB))) #define ERTS_PROC_GET_CALL_TIME(P) \ ((process_breakpoint_time_t *) erts_psd_get((P), ERTS_PSD_CALL_TIME_BP)) -#define ERTS_PROC_SET_CALL_TIME(P, L, PBT) \ - ((process_breakpoint_time_t *) erts_psd_set((P), (L), ERTS_PSD_CALL_TIME_BP, (void *) (PBT))) +#define ERTS_PROC_SET_CALL_TIME(P, PBT) \ + ((process_breakpoint_time_t *) erts_psd_set((P), ERTS_PSD_CALL_TIME_BP, (void *) (PBT))) #define ERTS_PROC_GET_DELAYED_GC_TASK_QS(P) \ ((ErtsProcSysTaskQs *) erts_psd_get((P), ERTS_PSD_DELAYED_GC_TASK_QS)) -#define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, L, PBT) \ - ((ErtsProcSysTaskQs *) erts_psd_set((P), (L), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) +#define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, PBT) \ + ((ErtsProcSysTaskQs *) erts_psd_set((P), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) #define ERTS_PROC_GET_NIF_TRAP_EXPORT(P) \ erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT) -#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, L, NTE) \ - erts_psd_set((P), (L), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) +#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \ + erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); -ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, - ErtsProcLocks plocks, - Eterm handler); +ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Eterm @@ -2005,13 +2014,13 @@ erts_proc_get_error_handler(Process *p) } ERTS_GLB_INLINE Eterm -erts_proc_set_error_handler(Process *p, ErtsProcLocks plocks, Eterm handler) +erts_proc_set_error_handler(Process *p, Eterm handler) { void *old_val; void *new_val; ASSERT(is_atom(handler)); new_val = (handler == am_error_handler) ? NULL : (void *) (UWord) handler; - old_val = erts_psd_set(p, plocks, ERTS_PSD_ERROR_HANDLER, new_val); + old_val = erts_psd_set(p, ERTS_PSD_ERROR_HANDLER, new_val); if (!old_val) return am_error_handler; else { diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 39c36ee7a9..73552b28de 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -103,7 +103,7 @@ Uint erts_process_memory(Process *p, int incl_msg_inq) { size += p->arity * sizeof(p->arg_reg[0]); } - if (p->psd) + if (erts_smp_atomic_read_nob(&p->psd) != (erts_aint_t) NULL) size += sizeof(ErtsPSD); scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index d2343912b4..72a1e0b6ec 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -59,96 +59,6 @@ erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz) #endif } -__decl_noreturn static void __noreturn -et_abort(const char *expr, const char *file, unsigned line) -{ -#ifdef EXIT_ON_ET_ABORT - static int have_been_called = 0; - - if (have_been_called) { - abort(); - } else { - /* - * Prevent infinite loop. - */ - have_been_called = 1; - erts_exit(ERTS_ERROR_EXIT, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr); - } -#else - erts_fprintf(stderr, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr); - abort(); -#endif -} - -#if ET_DEBUG -#define ET_ASSERT(expr,file,line) \ -do { \ - if (!(expr)) \ - et_abort(#expr, file, line); \ -} while(0) -#else -#define ET_ASSERT(expr,file,line) do { } while(0) -#endif - -#if ET_DEBUG -unsigned tag_val_def_debug(Wterm x, const char *file, unsigned line) -#else -unsigned tag_val_def(Wterm x) -#define file __FILE__ -#define line __LINE__ -#endif -{ - static char msg[32]; - - switch (x & _TAG_PRIMARY_MASK) { - case TAG_PRIMARY_LIST: - ET_ASSERT(_list_precond(x),file,line); - return LIST_DEF; - case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(x); - ET_ASSERT(is_header(hdr),file,line); - switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { - case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF; - case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; - case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; - case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF; - case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF; - case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF; - case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF; - case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF; - case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF; - case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF; - case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF; - case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; - case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; - case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; - case (_TAG_HEADER_BIN_MATCHSTATE >> _TAG_PRIMARY_SIZE): return MATCHSTATE_DEF; - } - - break; - } - case TAG_PRIMARY_IMMED1: { - switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { - case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF; - case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF; - case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): { - switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) { - case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF; - case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF; - } - break; - } - case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF; - } - break; - } - } - erts_snprintf(msg, sizeof(msg), "tag_val_def: %#lx", (unsigned long) x); - et_abort(msg, file, line); -#undef file -#undef line -} - /* * XXX: define NUMBER_CODE() here when new representation is used */ diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 2b28762db5..0a71534790 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1129,11 +1129,11 @@ _ET_DECLARE_CHECKED(Uint,loader_y_reg_index,Uint) #define FIRST_VACANT_TAG_DEF 0x12 #if ET_DEBUG -extern unsigned tag_val_def_debug(Wterm, const char*, unsigned); -#define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__) +ERTS_GLB_INLINE unsigned tag_val_def(Wterm, const char*, unsigned); #else -extern unsigned tag_val_def(Wterm); +ERTS_GLB_INLINE unsigned tag_val_def(Wterm); #endif + #define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y))) #define NUMBER_CODE(x,y) ((tag_val_def(x) << 5) | tag_val_def(y)) @@ -1152,5 +1152,80 @@ extern unsigned tag_val_def(Wterm); void erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz); +#if ET_DEBUG +#define ET_ASSERT(expr,file,line) \ +do { \ + if (!(expr)) \ + erl_assert_error("TYPE ASSERTION: " #expr, __FUNCTION__, file, line); \ +} while(0) +#else +#define ET_ASSERT(expr,file,line) do { } while(0) +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#if ET_DEBUG +ERTS_GLB_INLINE unsigned tag_val_def(Wterm x, const char *file, unsigned line) +#else +ERTS_GLB_INLINE unsigned tag_val_def(Wterm x) +#define file __FILE__ +#define line __LINE__ +#endif +{ + static char *msg = "tag_val_def error"; + + switch (x & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + ET_ASSERT(_list_precond(x),file,line); + return LIST_DEF; + case TAG_PRIMARY_BOXED: { + Eterm hdr = *boxed_val(x); + ET_ASSERT(is_header(hdr),file,line); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF; + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; + case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF; + case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF; + case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF; + case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF; + case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF; + case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): return MAP_DEF; + case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_BIN_MATCHSTATE >> _TAG_PRIMARY_SIZE): return MATCHSTATE_DEF; + } + + break; + } + case TAG_PRIMARY_IMMED1: { + switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF; + case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF; + case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): { + switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) { + case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF; + case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF; + } + break; + } + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF; + } + break; + } + } + erl_assert_error(msg, __FUNCTION__, file, line); +#undef file +#undef line +} +#endif + +#if ET_DEBUG +#define tag_val_def(X) tag_val_def(X, __FILE__, __LINE__) +#endif + #endif /* __ERL_TERM_H */ diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c index 7ff456b915..30c9d70c59 100644 --- a/erts/emulator/beam/erl_thr_queue.c +++ b/erts/emulator/beam/erl_thr_queue.c @@ -780,3 +780,35 @@ erts_thr_q_dequeue(ErtsThrQ_t *q) return res; #endif } + +#ifdef USE_LTTNG_VM_TRACEPOINTS +int +erts_thr_q_length_dirty(ErtsThrQ_t *q) +{ + int n = 0; +#ifndef USE_THREADS + void *res; + ErtsThrQElement_t *tmp; + + for (tmp = q->first; tmp != NULL; tmp = tmp->next) { + n++; + } +#else + ErtsThrQElement_t *e; + erts_aint_t inext; + + e = ErtsThrQDirtyReadEl(&q->head.head); + inext = erts_atomic_read_acqb(&e->next); + + while (inext != ERTS_AINT_NULL) { + e = (ErtsThrQElement_t *) inext; + if (e != &q->tail.data.marker) { + /* don't count marker */ + n++; + } + inext = erts_atomic_read_acqb(&e->next); + } +#endif + return n; +} +#endif diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h index 27a6d03224..f5e5522948 100644 --- a/erts/emulator/beam/erl_thr_queue.h +++ b/erts/emulator/beam/erl_thr_queue.h @@ -190,6 +190,10 @@ void erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *, int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *); void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *); +#ifdef USE_LTTNG_VM_TRACEPOINTS +int erts_thr_q_length_dirty(ErtsThrQ_t *); +#endif + #ifdef ERTS_SMP ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q); #endif diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 41876b8c62..9033c1b75c 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -176,7 +176,7 @@ take_timestamp(ErtsTraceTimeStamp *tsp, int ts_type) hsz += 3; /* 2-tuple */ raw_unique = erts_raw_get_unique_monotonic_integer(); tsp->u.monotonic.raw_unique = raw_unique; - hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique); + hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique, 0); } return hsz; } @@ -216,8 +216,7 @@ write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp) return emtime; raw = tsp->u.monotonic.raw_unique; - unique = erts_raw_make_unique_monotonic_integer_value(hpp, - raw); + unique = erts_raw_make_unique_monotonic_integer_value(hpp, raw, 0); res = TUPLE2(*hpp, emtime, unique); *hpp += 3; return res; diff --git a/erts/emulator/beam/erlang_lttng.c b/erts/emulator/beam/erlang_lttng.c new file mode 100644 index 0000000000..fce40eedc1 --- /dev/null +++ b/erts/emulator/beam/erlang_lttng.c @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef USE_LTTNG +#define TRACEPOINT_CREATE_PROBES +/* + * The header containing our TRACEPOINT_EVENTs. + */ +#define TRACEPOINT_DEFINE +#include "erlang_lttng.h" +#endif /* USE_LTTNG */ diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h new file mode 100644 index 0000000000..43ceeda671 --- /dev/null +++ b/erts/emulator/beam/erlang_lttng.h @@ -0,0 +1,424 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifdef USE_LTTNG +#undef TRACEPOINT_PROVIDER +#define TRACEPOINT_PROVIDER com_ericsson_otp + +#undef TRACEPOINT_INCLUDE +#define TRACEPOINT_INCLUDE "erlang_lttng.h" + +#if !defined(__ERLANG_LTTNG_H__) || defined(TRACEPOINT_HEADER_MULTI_READ) +#define __ERLANG_LTTNG_H__ + +#include <lttng/tracepoint.h> + +/* Schedulers */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + scheduler_poll, + TP_ARGS( + int, id, + int, runnable + ), + TP_FIELDS( + ctf_integer(int, scheduler, id) + ctf_integer(int, runnable, runnable) + ) +) + +#ifndef LTTNG_CARRIER_STATS +#define LTTNG_CARRIER_STATS +typedef struct { + unsigned long no; + unsigned long size; +} lttng_stat_values_t; + +typedef struct { + lttng_stat_values_t carriers; + lttng_stat_values_t blocks; +} lttng_carrier_stats_t; +#endif + + +/* Port and Driver Scheduling */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_start, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_init, + TP_ARGS( + char*, driver, + int, major, + int, minor, + int, flags + ), + TP_FIELDS( + ctf_string(driver, driver) + ctf_integer(int, major, major) + ctf_integer(int, minor, minor) + ctf_integer(int, flags, flags) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_outputv, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_output, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_input, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_output, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_event, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_timeout, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_stop_select, + TP_ARGS( + char*, driver + ), + TP_FIELDS( + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_flush, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_stop, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_process_exit, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_async, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_finish, + TP_ARGS( + char*, driver + ), + TP_FIELDS( + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_call, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + unsigned int, command, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(unsigned int, command, command) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_control, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + unsigned int, command, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(unsigned int, command, command) + ctf_integer(size_t, bytes, bytes) + ) +) + +/* Async pool */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + aio_pool_get, + TP_ARGS( + char*, port, + int, length + ), + TP_FIELDS( + ctf_string(port, port) + ctf_integer(int, length, length) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + aio_pool_add, + TP_ARGS( + char*, port, + int, length + ), + TP_FIELDS( + ctf_string(port, port) + ctf_integer(int, length, length) + ) +) + + +/* Memory Allocator */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_create, + TP_ARGS( + const char*, type, + int, instance, + unsigned long, size, + lttng_carrier_stats_t *, mbcs, + lttng_carrier_stats_t *, sbcs + ), + TP_FIELDS( + ctf_string(type, type) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no) + ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size) + ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no) + ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size) + ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no) + ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size) + ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no) + ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size) + ) +) + + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_destroy, + TP_ARGS( + const char*, type, + int, instance, + unsigned long, size, + lttng_carrier_stats_t *, mbcs, + lttng_carrier_stats_t *, sbcs + ), + TP_FIELDS( + ctf_string(type, type) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no) + ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size) + ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no) + ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size) + ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no) + ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size) + ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no) + ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_pool_put, + TP_ARGS( + const char*, name, + int, instance, + unsigned long, size + ), + TP_FIELDS( + ctf_string(type, name) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_pool_get, + TP_ARGS( + const char*, name, + int, instance, + unsigned long, size + ), + TP_FIELDS( + ctf_string(type, name) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ) +) + +#endif /* __ERLANG_LTTNG_H__ */ +#include <lttng/tracepoint-event.h> +#endif /* USE_LTTNG */ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index aac1490f0c..10f03636ec 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -967,19 +967,24 @@ erts_decode_dist_ext(ErtsHeapFactory* factory, return THE_NON_VALUE; } -Eterm erts_decode_ext(ErtsHeapFactory* factory, byte **ext) +Eterm erts_decode_ext(ErtsHeapFactory* factory, byte **ext, Uint32 flags) { + ErtsDistExternal ede, *edep; Eterm obj; byte *ep = *ext; if (*ep++ != VERSION_MAGIC) { erts_factory_undo(factory); return THE_NON_VALUE; } - ep = dec_term(NULL, factory, ep, &obj, NULL); + if (flags) { + ASSERT(flags == ERTS_DIST_EXT_BTT_SAFE); + ede.flags = flags; /* a dummy struct just for the flags */ + edep = &ede; + } else { + edep = NULL; + } + ep = dec_term(edep, factory, ep, &obj, NULL); if (!ep) { -#ifdef DEBUG - bin_write(ERTS_PRINT_STDERR,NULL,*ext,500); -#endif return THE_NON_VALUE; } *ext = ep; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index d12051c6b4..87eff2fe9f 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -191,7 +191,7 @@ Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *); Sint erts_decode_ext_size(byte*, Uint); Sint erts_decode_ext_size_ets(byte*, Uint); -Eterm erts_decode_ext(ErtsHeapFactory*, byte**); +Eterm erts_decode_ext(ErtsHeapFactory*, byte**, Uint32 flags); Eterm erts_decode_ext_ets(ErtsHeapFactory*, byte*); Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 797e4cdadc..b85b581cdc 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -47,6 +47,7 @@ #define ERTS_WANT_EXTERNAL_TAGS #include "external.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include "erl_map.h" #include "erl_bif_unique.h" #include "erl_hl_timer.h" @@ -397,7 +398,7 @@ static Port *create_port(char *name, prt->common.u.alive.reg = NULL; ERTS_PTMR_INIT(prt); erts_port_task_handle_init(&prt->timeout_task); - prt->psd = NULL; + erts_smp_atomic_init_nob(&prt->psd, (erts_aint_t) NULL); prt->async_open_port = NULL; prt->drv_data = (SWord) 0; prt->os_pid = -1; @@ -717,7 +718,19 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ DTRACE3(driver_start, process_str, driver->name, port_str); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); + +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_start)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(pid, proc_str); + lttng_port_to_str(port, port_str); + LTTNG3(driver_start, proc_str, driver->name, port_str); + } +#endif + fpe_was_unmasked = erts_block_fpe(); drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) @@ -1542,8 +1555,19 @@ erts_schedule_proc2port_signal(Process *c_p, erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); if (sched_res != 0) { - if (refp) + if (refp) { + /* + * We need to restore the message queue save + * pointer to the beginning of the message queue + * since the caller now wont wait for a message + * containing the reference created above... + */ + ASSERT(c_p); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + JOIN_MESSAGE(c_p); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); *refp = NIL; + } return ERTS_PORT_OP_DROPPED; } return ERTS_PORT_OP_SCHEDULED; @@ -1724,6 +1748,15 @@ call_driver_outputv(int bang_op, DTRACE4(driver_outputv, process_str, port_str, prt->name, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_outputv)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG4(driver_outputv, proc_str, port_str, prt->name, size); + } +#endif prt->caller = caller; (*drv->outputv)((ErlDrvData) prt->drv_data, evp); @@ -1749,7 +1782,6 @@ cleanup_scheduled_outputv(ErlIOVec *ev, ErlDrvBinary *cbinp) driver_free_binary(ev->binv[i]); if (cbinp) driver_free_binary(cbinp); - erts_free(ERTS_ALC_T_DRV_CMD_DATA, ev); } static int @@ -1826,6 +1858,15 @@ call_driver_output(int bang_op, DTRACE4(driver_output, process_str, port_str, prt->name, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_output)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG4(driver_output, proc_str, port_str, prt->name, size); + } +#endif prt->caller = caller; (*drv->output)((ErlDrvData) prt->drv_data, bufp, size); @@ -1887,6 +1928,188 @@ port_sig_output(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *si return ERTS_PORT_REDS_CMD_OUTPUT; } + +/* + * This erts_port_output will always create a port task. + * The call is treated as a port_command call, i.e. no + * badsig i generated if the input in invalid. However + * an error_logger message is generated. + */ +int +erts_port_output_async(Port *prt, Eterm from, Eterm list) +{ + + ErtsPortOpResult res; + ErtsProc2PortSigData *sigdp; + erts_driver_t *drv = prt->drv_ptr; + size_t size; + int task_flags; + ErtsProc2PortSigCallback port_sig_callback; + ErlDrvBinary *cbin = NULL; + ErlIOVec *evp = NULL; + char *buf = NULL; + ErtsPortTaskHandle *ns_pthp; + + if (drv->outputv) { + ErlIOVec ev; + SysIOVec* ivp; + ErlDrvBinary** bvp; + int vsize; + Uint csize; + Uint pvsize; + Uint pcsize; + size_t iov_offset, binv_offset, alloc_size; + Uint blimit = 0; + char *ptr; + int i; + + Eterm* bptr = NULL; + Uint offset; + + if (is_binary(list)) { + /* We optimize for when we get a procbin without offset */ + Eterm real_bin; + int bitoffs; + int bitsize; + ERTS_GET_REAL_BIN(list, real_bin, offset, bitoffs, bitsize); + bptr = binary_val(real_bin); + if (*bptr == HEADER_PROC_BIN && bitoffs == 0) { + size = binary_size(list); + vsize = 1; + } else + bptr = NULL; + } + + if (!bptr) { + if (io_list_vec_len(list, &vsize, &csize, &pvsize, &pcsize, &size)) + goto bad_value; + + /* To pack or not to pack (small binaries) ...? */ + if (vsize >= SMALL_WRITE_VEC) { + /* Do pack */ + vsize = pvsize + 1; + csize = pcsize; + blimit = ERL_SMALL_IO_BIN_LIMIT; + } + cbin = driver_alloc_binary(csize); + if (!cbin) + erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, ERTS_SIZEOF_Binary(csize)); + } + + + iov_offset = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(ErlIOVec)); + binv_offset = iov_offset; + binv_offset += ERTS_ALC_DATA_ALIGN_SIZE((vsize+1)*sizeof(SysIOVec)); + alloc_size = binv_offset; + alloc_size += (vsize+1)*sizeof(ErlDrvBinary *); + + sigdp = erts_port_task_alloc_p2p_sig_data_extra(alloc_size, (void**)&ptr); + + evp = (ErlIOVec *) ptr; + ivp = evp->iov = (SysIOVec *) (ptr + iov_offset); + bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset); + + ivp[0].iov_base = NULL; + ivp[0].iov_len = 0; + bvp[0] = NULL; + + if (bptr) { + ProcBin* pb = (ProcBin *) bptr; + + ivp[1].iov_base = pb->bytes+offset; + ivp[1].iov_len = size; + bvp[1] = Binary2ErlDrvBinary(pb->val); + + evp->vsize = 1; + } else { + + evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); + if (evp->vsize < 0) { + if (evp != &ev) + erts_free(ERTS_ALC_T_DRV_CMD_DATA, evp); + driver_free_binary(cbin); + goto bad_value; + } + } +#if 0 + /* This assertion may say something useful, but it can + be falsified during the emulator test suites. */ + ASSERT(evp->vsize == vsize); +#endif + evp->vsize++; + evp->size = size; /* total size */ + + /* Need to increase refc on all binaries */ + for (i = 1; i < evp->vsize; i++) + if (bvp[i]) + driver_binary_inc_refc(bvp[i]); + + sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV; + sigdp->u.outputv.from = from; + sigdp->u.outputv.evp = evp; + sigdp->u.outputv.cbinp = cbin; + port_sig_callback = port_sig_outputv; + } else { + ErlDrvSizeT ERTS_DECLARE_DUMMY(r); + + /* + * Apperently there exist code that write 1 byte to + * much in buffer. Where it resides I don't know, but + * we can live with one byte extra allocated... + */ + + if (erts_iolist_size(list, &size)) + goto bad_value; + + buf = erts_alloc(ERTS_ALC_T_DRV_CMD_DATA, size + 1); + + r = erts_iolist_to_buf(list, buf, size); + ASSERT(ERTS_IOLIST_TO_BUF_SUCCEEDED(r)); + + sigdp = erts_port_task_alloc_p2p_sig_data(); + sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUT; + sigdp->u.output.from = from; + sigdp->u.output.bufp = buf; + sigdp->u.output.size = size; + port_sig_callback = port_sig_output; + } + sigdp->flags = 0; + ns_pthp = NULL; + task_flags = 0; + + res = erts_schedule_proc2port_signal(NULL, + prt, + ERTS_INVALID_PID, + NULL, + sigdp, + task_flags, + ns_pthp, + port_sig_callback); + + if (res != ERTS_PORT_OP_SCHEDULED) { + if (drv->outputv) + cleanup_scheduled_outputv(evp, cbin); + else + cleanup_scheduled_output(buf); + return 1; + } + return 1; + +bad_value: + + /* + * We call badsig directly here as this function is called with + * the main lock of the calling process still held. + * At the moment this operation is always not a bang_op, so + * only an error_logger message should be generated, no badsig. + */ + + badsig_received(0, prt, erts_atomic32_read_nob(&prt->state), 1); + + return 0; + +} + ErtsPortOpResult erts_port_output(Process *c_p, int flags, @@ -1896,7 +2119,7 @@ erts_port_output(Process *c_p, Eterm *refp) { ErtsPortOpResult res; - ErtsProc2PortSigData *sigdp; + ErtsProc2PortSigData *sigdp = NULL; erts_driver_t *drv = prt->drv_ptr; size_t size; int try_call; @@ -1949,7 +2172,6 @@ erts_port_output(Process *c_p, DTRACE4(port_command, process_str, port_str, prt->name, "command"); } #endif - if (drv->outputv) { ErlIOVec ev; SysIOVec iv[SMALL_WRITE_VEC]; @@ -1978,10 +2200,13 @@ erts_port_output(Process *c_p, evp = &ev; } else { - char *ptr = erts_alloc((try_call - ? ERTS_ALC_T_TMP - : ERTS_ALC_T_DRV_CMD_DATA), alloc_size); - + char *ptr; + if (try_call) { + ptr = erts_alloc(ERTS_ALC_T_TMP, alloc_size); + } else { + sigdp = erts_port_task_alloc_p2p_sig_data_extra( + alloc_size, (void**)&ptr); + } evp = (ErlIOVec *) ptr; ivp = evp->iov = (SysIOVec *) (ptr + iov_offset); bvp = evp->binv = (ErlDrvBinary **) (ptr + binv_offset); @@ -2010,9 +2235,12 @@ erts_port_output(Process *c_p, bvp[0] = NULL; evp->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); if (evp->vsize < 0) { - if (evp != &ev) - erts_free(try_call ? ERTS_ALC_T_TMP : ERTS_ALC_T_DRV_CMD_DATA, - evp); + if (evp != &ev) { + if (try_call) + erts_free(ERTS_ALC_T_TMP, evp); + else + erts_port_task_free_p2p_sig_data(sigdp); + } driver_free_binary(cbin); goto bad_value; } @@ -2064,8 +2292,10 @@ erts_port_output(Process *c_p, /* Fall through... */ case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: driver_free_binary(cbin); - if (evp != &ev) + if (evp != &ev) { + ASSERT(!sigdp); erts_free(ERTS_ALC_T_TMP, evp); + } if (try_call_res != ERTS_TRY_IMM_DRV_CALL_OK) return ERTS_PORT_OP_DROPPED; if (c_p) @@ -2076,8 +2306,10 @@ erts_port_output(Process *c_p, if (async_nosuspend && (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))) { driver_free_binary(cbin); - if (evp != &ev) + if (evp != &ev) { + ASSERT(!sigdp); erts_free(ERTS_ALC_T_TMP, evp); + } return ((sched_flags & ERTS_PTS_FLG_EXIT) ? ERTS_PORT_OP_DROPPED : ERTS_PORT_OP_BUSY); @@ -2092,9 +2324,16 @@ erts_port_output(Process *c_p, if (bvp[i]) driver_binary_inc_refc(bvp[i]); - new_evp = erts_alloc(ERTS_ALC_T_DRV_CMD_DATA, alloc_size); + /* The port task and iovec is allocated in the + same structure as an optimization. This + is especially important in erts_port_output_async + of when !try_call */ + ASSERT(sigdp == NULL); + sigdp = erts_port_task_alloc_p2p_sig_data_extra( + alloc_size, (void**)&new_evp); if (evp != &ev) { + /* Copy from TMP alloc to port task */ sys_memcpy((void *) new_evp, (void *) evp, alloc_size); new_evp->iov = (SysIOVec *) (((char *) new_evp) + iov_offset); @@ -2142,7 +2381,6 @@ erts_port_output(Process *c_p, evp = new_evp; } - sigdp = erts_port_task_alloc_p2p_sig_data(); sigdp->flags = ERTS_P2P_SIG_TYPE_OUTPUTV; sigdp->u.outputv.from = from; sigdp->u.outputv.evp = evp; @@ -3489,6 +3727,17 @@ static void flush_port(Port *p) DTRACE3(driver_flush, process_str, port_str, p->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_flush)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str); + lttng_port_to_str(p, port_str); + LTTNG3(driver_flush, proc_str, port_str, p->name); + } +#endif + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_in, am_flush); } @@ -3520,6 +3769,7 @@ terminate_port(Port *prt) Eterm connected_id = NIL /* Initialize to silence compiler */; erts_driver_t *drv; erts_aint32_t state; + ErtsPrtSD *psd; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -3551,6 +3801,16 @@ terminate_port(Port *prt) DTRACE3(driver_stop, process_str, drv->name, port_str); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_stop)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(connected_id, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG3(driver_stop, proc_str, drv->name, port_str); + } +#endif + (*drv->stop)((ErlDrvData)prt->drv_data); erts_unblock_fpe(fpe_was_unmasked); ERTS_MSACC_POP_STATE_M(); @@ -3573,8 +3833,9 @@ terminate_port(Port *prt) erts_cleanup_port_data(prt); - if (prt->psd) - erts_free(ERTS_ALC_T_PRTSD, prt->psd); + psd = (ErtsPrtSD *) erts_smp_atomic_read_nob(&prt->psd); + if (psd) + erts_free(ERTS_ALC_T_PRTSD, psd); ASSERT(prt->dist_entry == NULL); @@ -3881,6 +4142,16 @@ call_driver_control(Eterm caller, ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_control)) { + lttng_decl_procbuf(proc_str); + lttng_decl_portbuf(port_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG5(driver_control, proc_str, port_str, prt->name, command, size); + } +#endif + prt->caller = caller; cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data, command, @@ -4294,6 +4565,15 @@ call_driver_call(Eterm caller, DTRACE5(driver_call, process_str, port_str, prt->name, command, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_call)) { + lttng_decl_procbuf(proc_str); + lttng_decl_portbuf(port_str); + lttng_pid_to_str(caller,proc_str); + lttng_port_to_str(prt, port_str); + LTTNG5(driver_call, proc_str, port_str, prt->name, command, size); + } +#endif ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); @@ -4373,7 +4653,7 @@ port_sig_call(Port *prt, (void) erts_factory_message_create(&factory, rp, &rp_locks, hsz); endp = (byte *) resp_bufp; - msg = erts_decode_ext(&factory, &endp); + msg = erts_decode_ext(&factory, &endp, 0); if (is_value(msg)) { hp = erts_produce_heap(&factory, 3, @@ -4492,7 +4772,7 @@ erts_port_call(Process* c_p, hsz += 3; erts_factory_proc_prealloc_init(&factory, c_p, hsz); endp = (byte *) resp_bufp; - term = erts_decode_ext(&factory, &endp); + term = erts_decode_ext(&factory, &endp, 0); if (term == THE_NON_VALUE) return ERTS_PORT_OP_BADARG; hp = erts_produce_heap(&factory,3,0); @@ -5056,6 +5336,15 @@ int async_ready(Port *p, void* data) DTRACE3(driver_ready_async, process_str, port_str, p->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_ready_async)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str); + lttng_port_to_str(p, port_str); + LTTNG3(driver_ready_async, proc_str, port_str, p->name); + } +#endif (*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data); need_free = 0; ERTS_MSACC_POP_STATE_M(); @@ -7102,6 +7391,15 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) DTRACE3(driver_process_exit, process_str, port_str, prt->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_process_exit)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(prt), proc_str); + lttng_port_to_str(prt, port_str); + LTTNG3(driver_process_exit, proc_str, port_str, prt->name); + } +#endif fpe_was_unmasked = erts_block_fpe(); (*callback)((ErlDrvData) (prt->drv_data), &drv_monitor); erts_unblock_fpe(fpe_was_unmasked); @@ -7579,6 +7877,8 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) int fpe_was_unmasked = erts_block_fpe(); DTRACE4(driver_init, drv->name, drv->version.major, drv->version.minor, drv->flags); + LTTNG4(driver_init, drv->name, drv->version.major, drv->version.minor, + drv->flags); res = (*de->init)(); erts_unblock_fpe(fpe_was_unmasked); return res; diff --git a/erts/emulator/beam/lttng-wrapper.h b/erts/emulator/beam/lttng-wrapper.h new file mode 100644 index 0000000000..294872c365 --- /dev/null +++ b/erts/emulator/beam/lttng-wrapper.h @@ -0,0 +1,107 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#ifndef __LTTNG_WRAPPER_H__ +#define __LTTNG_WRAPPER_H__ + +#ifdef USE_LTTNG + +#include "erlang_lttng.h" +#define USE_LTTNG_VM_TRACEPOINTS + +#define LTTNG_BUFFER_SZ (256) +#define LTTNG_PROC_BUFFER_SZ (16) +#define LTTNG_PORT_BUFFER_SZ (20) +#define LTTNG_MFA_BUFFER_SZ (256) + +#define lttng_decl_procbuf(Name) \ + char Name[LTTNG_PROC_BUFFER_SZ] + +#define lttng_decl_portbuf(Name) \ + char Name[LTTNG_PORT_BUFFER_SZ] + +#define lttng_decl_mfabuf(Name) \ + char Name[LTTNG_MFA_BUFFER_SZ] + +#define lttng_decl_carrier_stats(Name) \ + lttng_carrier_stats_t Name##_STATSTRUCT, *Name = &Name##_STATSTRUCT + +#define lttng_pid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PROC_BUFFER_SZ, "%T", (pid)) + +#define lttng_portid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PORT_BUFFER_SZ, "%T", (pid)) + +#define lttng_proc_to_str(p, name) \ + lttng_pid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PID), name) + +#define lttng_port_to_str(p, name) \ + lttng_portid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PORT), name) + +#define lttng_mfa_to_str(m,f,a, Name) \ + erts_snprintf(Name, LTTNG_MFA_BUFFER_SZ, "%T:%T/%lu", (Eterm)(m), (Eterm)(f), (Uint)(a)) + +#define lttng_proc_to_mfa_str(p, Name) \ + do { \ + if (ERTS_PROC_IS_EXITING((p))) { \ + strcpy(Name, "<exiting>"); \ + } else { \ + BeamInstr *_fptr = find_function_from_pc((p)->i); \ + if (_fptr) { \ + lttng_mfa_to_str(_fptr[0],_fptr[1],_fptr[2], Name); \ + } else { \ + strcpy(Name, "<unknown>"); \ + } \ + } \ + } while(0) + +/* ErtsRunQueue->ErtsSchedulerData->Uint */ +#define lttng_rq_to_id(RQ) \ + (RQ)->scheduler->no + +#define LTTNG_ENABLED(Name) \ + tracepoint_enabled(com_ericsson_otp, Name) + +/* include a special LTTNG_DO for do_tracepoint ? */ +#define LTTNG1(Name, Arg1) \ + tracepoint(com_ericsson_otp, Name, (Arg1)) + +#define LTTNG2(Name, Arg1, Arg2) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2)) + +#define LTTNG3(Name, Arg1, Arg2, Arg3) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3)) + +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4)) + +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4), (Arg5)) + +#else /* USE_LTTNG */ + +#define LTTNG1(Name, Arg1) do {} while(0) +#define LTTNG2(Name, Arg1, Arg2) do {} while(0) +#define LTTNG3(Name, Arg1, Arg2, Arg3) do {} while(0) +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) do {} while(0) +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) do {} while(0) + +#endif /* USE_LTTNG */ +#endif /* __LTTNG_WRAPPER_H__ */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 9e53b4bfcc..15f27835a8 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -181,11 +181,6 @@ i_jump_on_val_zero y f I i_jump_on_val x f I I i_jump_on_val y f I I -jump Target | label Lbl | same_label(Target, Lbl) => label Lbl - -is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \ - is_eq_exact Fail S1 S2 | label L2 - %macro: get_list GetList -pack get_list x x x get_list x x y @@ -303,7 +298,7 @@ move_window5 x x x x x y # Swap registers. move R1=x Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp -swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed(Tmp, Live) => \ +swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed_apply(Tmp, Live) => \ swap R1 R2 | line Loc | apply Live swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \ @@ -1355,9 +1350,7 @@ bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s -bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src - -i_bs_put_utf16 j I s +bs_put_utf16 j I s bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src @@ -1539,7 +1532,6 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # GCing arithmetic instructions. # -gen_plus Fail Live Y=y X=x Dst => i_plus Fail Live X Y Dst gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 03b9088adc..44735c0ec0 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -138,10 +138,10 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; #endif #if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0) -#ifndef __llvm__ -# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") )) -#else +#if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__) # define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") )) +#else +# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") )) #endif #else # define ERTS_WRITE_UNLIKELY(X) X diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 3088dfd572..ee14bd8bba 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -2900,12 +2900,12 @@ file_output(ErlDrvData e, char* buf, ErlDrvSizeT count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(buf + 9*4) + FILENAME_CHARSIZE); - d->info.mode = get_int32(buf + 0 * 4); - d->info.uid = get_int32(buf + 1 * 4); - d->info.gid = get_int32(buf + 2 * 4); - d->info.accessTime = (time_t)((Sint64)get_int64(buf + 3 * 4)); - d->info.modifyTime = (time_t)((Sint64)get_int64(buf + 5 * 4)); - d->info.cTime = (time_t)((Sint64)get_int64(buf + 7 * 4)); + d->info.mode = get_int32(buf + 0 * 4); + d->info.uid = get_int32(buf + 1 * 4); + d->info.gid = get_int32(buf + 2 * 4); + d->info.accessTime = get_int64(buf + 3 * 4); + d->info.modifyTime = get_int64(buf + 5 * 4); + d->info.cTime = get_int64(buf + 7 * 4); FILENAME_COPY(d->b, buf + 9*4); #ifdef USE_VM_PROBES diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index be5a891486..7ffeed6b9d 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -105,9 +105,9 @@ typedef struct _Efile_info { Uint32 inode; /* Inode number. */ Uint32 uid; /* User id of owner. */ Uint32 gid; /* Group id of owner. */ - time_t accessTime; /* Last time the file was accessed. */ - time_t modifyTime; /* Last time the file was modified. */ - time_t cTime; /* Creation time (Windows) or last + Sint64 accessTime; /* Last time the file was accessed. */ + Sint64 modifyTime; /* Last time the file was modified. */ + Sint64 cTime; /* Creation time (Windows) or last * inode change (Unix). */ } Efile_info; diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 4f15ce0980..35ccfa589a 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -823,12 +823,13 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { if (sz == 0) { driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, ERL_DRV_WRITE,0); - if (ttysl_terminate) + if (ttysl_terminate) { /* flush has been called, which means we should terminate when queue is empty. This will not send any exit message */ DEBUGLOG(("ttysl_to_tty: ttysl_terminate normal\n")); driver_failure_atom(ttysl_port, "normal"); + } break; } } diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index c097bc1950..0861435264 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -537,9 +537,9 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, else pInfo->type = FT_OTHER; - pInfo->accessTime = statbuf.st_atime; - pInfo->modifyTime = statbuf.st_mtime; - pInfo->cTime = statbuf.st_ctime; + pInfo->accessTime = (Sint64)statbuf.st_atime; + pInfo->modifyTime = (Sint64)statbuf.st_mtime; + pInfo->cTime = (Sint64)statbuf.st_ctime; pInfo->mode = statbuf.st_mode; pInfo->links = statbuf.st_nlink; @@ -578,8 +578,8 @@ efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) } } - tval.actime = pInfo->accessTime; - tval.modtime = pInfo->modifyTime; + tval.actime = (time_t)pInfo->accessTime; + tval.modtime = (time_t)pInfo->modifyTime; return check_error(utime(name, &tval), errInfo); } diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index f87196d724..0d5043fa2a 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -39,6 +39,7 @@ #include "erl_check_io.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" @@ -395,6 +396,7 @@ forget_removed(struct pollset_info* psi) if (drv_ptr) { int was_unmasked = erts_block_fpe(); DTRACE1(driver_stop_select, drv_ptr->name); + LTTNG1(driver_stop_select, drv_ptr->name); (*drv_ptr->stop_select) ((ErlDrvEvent) fd, NULL); erts_unblock_fpe(was_unmasked); if (drv_ptr->handle) { @@ -1055,6 +1057,7 @@ done_unknown: if (stop_select_fn) { int was_unmasked = erts_block_fpe(); DTRACE1(driver_stop_select, name); + LTTNG1(driver_stop_select, "unknown"); (*stop_select_fn)(e, NULL); erts_unblock_fpe(was_unmasked); } diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index ea7523ddc2..391bbd4cbc 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -3079,6 +3079,8 @@ erl_bin_write(buf, sz, max) } } +#endif /* DEBUG */ + void erl_assert_error(const char* expr, const char* func, const char* file, int line) { @@ -3094,7 +3096,6 @@ erl_assert_error(const char* expr, const char* func, const char* file, int line) DebugBreak(); } -#endif /* DEBUG */ static void check_supported_os_version(void) diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 318db4b45e..0f716c11a1 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -70,6 +70,7 @@ MODULES= \ hash_SUITE \ hibernate_SUITE \ list_bif_SUITE \ + lttng_SUITE \ map_SUITE \ match_spec_SUITE \ module_info_SUITE \ diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 07dfeb6633..f61ab431e9 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -24,9 +24,9 @@ init_per_group/2,end_per_group/2, packed_registers/1, apply_last/1, apply_last_bif/1, buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1, - select_val/1]). + select_val/1, swap_temp_apply/1]). --export([applied/2]). +-export([applied/2,swap_temp_applied/1]). -include_lib("common_test/include/ct.hrl"). @@ -34,7 +34,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [packed_registers, apply_last, apply_last_bif, - buildo_mucho, heap_sizes, big_lists, select_val]. + buildo_mucho, heap_sizes, big_lists, select_val, + swap_temp_apply]. groups() -> []. @@ -346,3 +347,41 @@ do_select_val(X) -> Int when is_integer(Int) -> integer end. + +swap_temp_apply(_Config) -> + {swap_temp_applied,42} = do_swap_temp_apply(41), + not_an_integer = do_swap_temp_apply(not_an_integer), + ok. + +do_swap_temp_apply(Msg) -> + case swap_temp_apply_function(Msg) of + undefined -> Msg; + Type -> + %% The following sequence: + %% move {x,0} {x,2} + %% move {y,0} {x,0} + %% move {x,2} {y,0} + %% apply 1 + %% + %% Would be incorrectly transformed to: + %% swap {x,0} {y,0} + %% apply 1 + %% + %% ({x,1} is the module, {x,2} the function to be applied). + %% + %% If the instructions are to be transformed, the correct + %% transformation is: + %% + %% swap_temp {x,0} {y,0} {x,2} + %% apply 1 + Fields = ?MODULE:Type(Msg), + {Type,Fields} + end. + +swap_temp_apply_function(Int) when is_integer(Int) -> + swap_temp_applied; +swap_temp_apply_function(_) -> + undefined. + +swap_temp_applied(Int) -> + Int+1. diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl new file mode 100644 index 0000000000..d0f6292d5b --- /dev/null +++ b/erts/emulator/test/lttng_SUITE.erl @@ -0,0 +1,499 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(lttng_SUITE). + +-export([all/0, suite/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([t_lttng_list/1, + t_carrier_pool/1, + t_memory_carrier/1, + t_async_io_pool/1, + t_driver_control_ready_async/1, + t_driver_start_stop/1, + t_driver_ready_input_output/1, + t_driver_timeout/1, + t_driver_caller/1, + t_driver_flush/1, + t_scheduler_poll/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [t_lttng_list, + t_carrier_pool, + t_async_io_pool, + t_driver_start_stop, + t_driver_ready_input_output, + t_driver_control_ready_async, + t_driver_timeout, + t_driver_caller, + t_driver_flush, + t_scheduler_poll, + t_memory_carrier]. + + +init_per_suite(Config) -> + case erlang:system_info(dynamic_trace) of + lttng -> + ensure_lttng_stopped("--all"), + Config; + _ -> + {skip, "No LTTng configured on system."} + end. + +end_per_suite(_Config) -> + ensure_lttng_stopped("--all"), + ok. + +init_per_testcase(Case, Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_started(Name, Config), + [{session, Name}|Config]. + +end_per_testcase(Case, _Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_stopped(Name), + ok. + +%% Not tested yet +%% com_ericsson_otp:driver_process_exit +%% com_ericsson_otp:driver_event + +%% tracepoints +%% +%% com_ericsson_otp:carrier_pool_get +%% com_ericsson_otp:carrier_pool_put +%% com_ericsson_otp:carrier_destroy +%% com_ericsson_otp:carrier_create +%% com_ericsson_otp:aio_pool_add +%% com_ericsson_otp:aio_pool_get +%% com_ericsson_otp:driver_control +%% com_ericsson_otp:driver_call +%% com_ericsson_otp:driver_finish +%% com_ericsson_otp:driver_ready_async +%% com_ericsson_otp:driver_process_exit +%% com_ericsson_otp:driver_stop +%% com_ericsson_otp:driver_flush +%% com_ericsson_otp:driver_stop_select +%% com_ericsson_otp:driver_timeout +%% com_ericsson_otp:driver_event +%% com_ericsson_otp:driver_ready_output +%% com_ericsson_otp:driver_ready_input +%% com_ericsson_otp:driver_output +%% com_ericsson_otp:driver_outputv +%% com_ericsson_otp:driver_init +%% com_ericsson_otp:driver_start +%% com_ericsson_otp:scheduler_poll + +%% +%% Testcases +%% + +t_lttng_list(_Config) -> + {ok, _} = cmd("lttng list -u"), + ok. + +%% com_ericsson_otp:carrier_pool_get +%% com_ericsson_otp:carrier_pool_put +t_carrier_pool(Config) -> + case have_carriers() of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:carrier_pool*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:carrier_pool_get", Res), + ok = check_tracepoint("com_ericsson_otp:carrier_pool_put", Res), + ok + end. + +%% com_ericsson_otp:carrier_destroy +%% com_ericsson_otp:carrier_create +t_memory_carrier(Config) -> + case have_carriers() of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:carrier_*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:carrier_destroy", Res), + ok = check_tracepoint("com_ericsson_otp:carrier_create", Res), + ok + end. + +%% com_ericsson_otp:aio_pool_add +%% com_ericsson_otp:aio_pool_get +t_async_io_pool(Config) -> + case have_async_threads() of + false -> + {skip, "No Async Threads configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:aio_pool_*", Config), + + Path1 = proplists:get_value(priv_dir, Config), + {ok, [[Path2]]} = init:get_argument(home), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:aio_pool_add", Res), + ok = check_tracepoint("com_ericsson_otp:aio_pool_get", Res), + ok + end. + + +%% com_ericsson_otp:driver_start +%% com_ericsson_otp:driver_stop +t_driver_start_stop(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_start", Res), + ok = check_tracepoint("com_ericsson_otp:driver_stop", Res), + ok = check_tracepoint("com_ericsson_otp:driver_control", Res), + ok = check_tracepoint("com_ericsson_otp:driver_outputv", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_async", Res), + ok. + +%% com_ericsson_otp:driver_control +%% com_ericsson_otp:driver_outputv +%% com_ericsson_otp:driver_ready_async +t_driver_control_ready_async(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_control", Config), + ok = lttng_start_event("com_ericsson_otp:driver_outputv", Config), + ok = lttng_start_event("com_ericsson_otp:driver_ready_async", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_control", Res), + ok = check_tracepoint("com_ericsson_otp:driver_outputv", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_async", Res), + ok. + +%% com_ericsson_otp:driver_ready_input +%% com_ericsson_otp:driver_ready_output +t_driver_ready_input_output(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_ready_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, active) end), + receive {Pid, accept} -> ok end, + Bin = txt(), + Sz = byte_size(Bin), + + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}]), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:close(Sock), + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_ready_input", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_output", Res), + ok. + + +%% com_ericsson_otp:driver_stop_select +%% com_ericsson_otp:driver_timeout +t_driver_timeout(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, timeout) end), + receive {Pid, accept} -> ok end, + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary]), + ok = gen_tcp:send(Sock, <<"hej">>), + receive {Pid, done} -> ok end, + ok = gen_tcp:close(Sock), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_timeout", Res), + ok = check_tracepoint("com_ericsson_otp:driver_stop_select", Res), + ok. + +%% com_ericsson_otp:driver_call +%% com_ericsson_otp:driver_output +%% com_ericsson_otp:driver_init +%% com_ericsson_otp:driver_finish +t_driver_caller(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + + Drv = 'caller_drv', + os:putenv("CALLER_DRV_USE_OUTPUTV", "false"), + + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + true = is_port(Port), + + chk_caller(Port, start, self()), + chk_caller(Port, output, spawn_link(fun() -> + port_command(Port, "") + end)), + Port ! {self(), {command, ""}}, + chk_caller(Port, output, self()), + chk_caller(Port, control, spawn_link(fun () -> + port_control(Port, 0, "") + end)), + chk_caller(Port, call, spawn_link(fun() -> + erlang:port_call(Port, 0, "") + end)), + + true = port_close(Port), + erl_ddll:unload_driver(Drv), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_call", Res), + ok = check_tracepoint("com_ericsson_otp:driver_output", Res), + ok = check_tracepoint("com_ericsson_otp:driver_init", Res), + ok = check_tracepoint("com_ericsson_otp:driver_finish", Res), + ok. + +%% com_ericsson_otp:scheduler_poll +t_scheduler_poll(Config) -> + ok = lttng_start_event("com_ericsson_otp:scheduler_poll", Config), + + ok = memory_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:scheduler_poll", Res), + ok. + +%% com_ericsson_otp:driver_flush +t_driver_flush(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_flush", Config), + + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, passive_no_read) end), + receive {Pid, accept} -> ok end, + Bin = iolist_to_binary([txt() || _ <- lists:seq(1,100)]), + Sz = byte_size(Bin), + + %% We want to create a scenario where sendings stalls and we + %% queue packets in the driver. + %% When we close the socket it has to flush the queue. + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}, + {send_timeout, 10}, + {sndbuf, 10000000}]), + Pids = [spawn_link(fun() -> + gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + Me ! {self(), ok} + end) || _ <- lists:seq(1,100)], + [receive {P, ok} -> ok end || P <- Pids], + ok = gen_tcp:close(Sock), + Pid ! die, + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_flush", Res), + ok. + +%% +%% AUX +%% + +chk_caller(Port, Callback, ExpectedCaller) -> + receive + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller + end. + + +ets_load() -> + Tid = ets:new(ets_load, [public,set]), + N = erlang:system_info(schedulers_online), + Pids = [spawn_link(fun() -> ets_shuffle(Tid) end) || _ <- lists:seq(1,N)], + ok = ets_kill(Pids, 500), + ok. + + +ets_kill([], _) -> ok; +ets_kill([Pid|Pids], Time) -> + timer:sleep(Time), + Pid ! done, + ets_kill(Pids, Time). + +ets_shuffle(Tid) -> + Payload = lists:duplicate(100, $x), + ets_shuffle(Tid, 100, Payload). +ets_shuffle(Tid, I, Data) -> + ets_shuffle(Tid, I, I, Data, Data). + +ets_shuffle(Tid, 0, N, _, Data) -> + ets_shuffle(Tid, N, N, Data, Data); +ets_shuffle(Tid, I, N, Data, Data0) -> + receive + done -> ok + after 0 -> + Key = rand:uniform(1000), + Data1 = [I|Data], + ets:insert(Tid, {Key, Data1}), + ets_shuffle(Tid, I - 1, N, Data1, Data0) + end. + + + + +memory_load() -> + Me = self(), + Pids0 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + timer:sleep(50), + Pids1 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + [receive {Pid, done} -> ok end || Pid <- Pids0 ++ Pids1], + timer:sleep(500), + ok. + +memory_loop(Parent, N, Bin) -> + memory_loop(Parent, N, Bin, []). + +memory_loop(Parent, 0, _Bin, _) -> + Parent ! {self(), done}; +memory_loop(Parent, N, Bin0, Ls) -> + Bin = binary:copy(<<Bin0/binary, Bin0/binary>>), + memory_loop(Parent, N - 1, Bin, [a,b,c|Ls]). + +tcp_server(Pid, Type) -> + {ok, LSock} = gen_tcp:listen(5679, [binary, + {reuseaddr, true}, + {active, false}]), + Pid ! {self(), accept}, + {ok, Sock} = gen_tcp:accept(LSock), + case Type of + passive_no_read -> + receive die -> ok end; + active -> + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg1 -> io:format("msg1: ~p~n", [Msg1]) end, + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg2 -> io:format("msg2: ~p~n", [Msg2]) end, + ok = gen_tcp:close(Sock); + timeout -> + Res = gen_tcp:recv(Sock, 2000, 1000), + io:format("res ~p~n", [Res]) + end, + Pid ! {self(), done}, + ok. + +txt() -> + <<"%% tracepoints\n" + "%%\n" + "%% com_ericsson_otp:carrier_pool_get\n" + "%% com_ericsson_otp:carrier_pool_put\n" + "%% com_ericsson_otp:carrier_destroy\n" + "%% com_ericsson_otp:carrier_create\n" + "%% com_ericsson_otp:aio_pool_add\n" + "%% com_ericsson_otp:aio_pool_get\n" + "%% com_ericsson_otp:driver_control\n" + "%% com_ericsson_otp:driver_call\n" + "%% com_ericsson_otp:driver_finish\n" + "%% com_ericsson_otp:driver_ready_async\n" + "%% com_ericsson_otp:driver_process_exit\n" + "%% com_ericsson_otp:driver_stop\n" + "%% com_ericsson_otp:driver_flush\n" + "%% com_ericsson_otp:driver_stop_select\n" + "%% com_ericsson_otp:driver_timeout\n" + "%% com_ericsson_otp:driver_event\n" + "%% com_ericsson_otp:driver_ready_output\n" + "%% com_ericsson_otp:driver_ready_input\n" + "%% com_ericsson_otp:driver_output\n" + "%% com_ericsson_otp:driver_outputv\n" + "%% com_ericsson_otp:driver_init\n" + "%% com_ericsson_otp:driver_start\n" + "%% com_ericsson_otp:scheduler_poll">>. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +%% check + +have_carriers() -> + Cap = element(3,erlang:system_info(allocator)), + case Cap -- [sys_alloc,sys_aligned_alloc] of + [] -> false; + _ -> true + end. + +have_async_threads() -> + Tps = erlang:system_info(thread_pool_size), + if Tps =:= 0 -> false; + true -> true + end. + +%% lttng +lttng_stop_and_view(Config) -> + Path = proplists:get_value(priv_dir, Config), + Name = proplists:get_value(session, Config), + {ok,_} = cmd("lttng stop " ++ Name), + {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path), + Res. + +check_tracepoint(TP, Data) -> + case re:run(Data, TP, [global]) of + {match, _} -> ok; + _ -> notfound + end. + +lttng_start_event(Event, Config) -> + Name = proplists:get_value(session, Config), + {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name), + {ok, _} = cmd("lttng start " ++ Name), + ok. + +ensure_lttng_started(Name, Config) -> + Out = case proplists:get_value(priv_dir, Config) of + undefined -> []; + Path -> "--output="++Path++" " + end, + {ok,_} = cmd("lttng create " ++ Out ++ Name), + ok. + +ensure_lttng_stopped(Name) -> + {ok,_} = cmd("lttng stop"), + {ok,_} = cmd("lttng destroy " ++ Name), + ok. + +cmd(Cmd) -> + io:format("<< ~ts~n", [Cmd]), + Res = os:cmd(Cmd), + io:format(">> ~ts~n", [Res]), + {ok,Res}. diff --git a/erts/emulator/test/lttng_SUITE_data/Makefile.src b/erts/emulator/test/lttng_SUITE_data/Makefile.src new file mode 100644 index 0000000000..fe7a1b6ef3 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/Makefile.src @@ -0,0 +1,7 @@ + +MISC_DRVS = caller_drv@dll@ + + +all: $(MISC_DRVS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/lttng_SUITE_data/caller_drv.c b/erts/emulator/test/lttng_SUITE_data/caller_drv.c new file mode 100644 index 0000000000..86fd0a2995 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/caller_drv.c @@ -0,0 +1,159 @@ +/* ``Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include <stdlib.h> +#include <string.h> +#include "erl_driver.h" + +static int init(); +static void stop(ErlDrvData drv_data); +static void finish(); +static void flush(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, char *command); +static void output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); +static void outputv(ErlDrvData drv_data, ErlIOVec *ev); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen); +static ErlDrvSSizeT call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry caller_drv_entry = { + init, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "caller_drv", + finish, + NULL /* handle */, + control, + NULL /* timeout */, + outputv, + NULL /* ready_async */, + flush, + call, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(caller_drv) +{ + char buf[10]; + size_t bufsz = sizeof(buf); + char *use_outputv; + use_outputv = (erl_drv_getenv("CALLER_DRV_USE_OUTPUTV", buf, &bufsz) == 0 + ? buf + : "false"); + if (strcmp(use_outputv, "true") != 0) + caller_drv_entry.outputv = NULL; + return &caller_drv_entry; +} + +void +send_caller(ErlDrvData drv_data, char *func) +{ + int res; + ErlDrvPort port = (ErlDrvPort) drv_data; + ErlDrvTermData msg[] = { + ERL_DRV_ATOM, driver_mk_atom("caller"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_ATOM, driver_mk_atom(func), + ERL_DRV_PID, driver_caller(port), + ERL_DRV_TUPLE, (ErlDrvTermData) 4 + }; + res = erl_drv_output_term(driver_mk_port(port), msg, sizeof(msg)/sizeof(ErlDrvTermData)); + if (res <= 0) + driver_failure_atom(port, "erl_drv_output_term failed"); +} + +static int +init() { + return 0; +} + +static void +stop(ErlDrvData drv_data) +{ + +} + +static void +flush(ErlDrvData drv_data) +{ + +} + +static void +finish() +{ + +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + send_caller((ErlDrvData) port, "start"); + return (ErlDrvData) port; +} + +static void +output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +{ + send_caller(drv_data, "output"); +} + +static void +outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + send_caller(drv_data, "outputv"); +} + +static ErlDrvSSizeT +control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + send_caller(drv_data, "control"); + return 0; +} + +static ErlDrvSSizeT +call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + /* echo call */ + if (len > rlen) + *rbuf = driver_alloc(len); + memcpy((void *) *rbuf, (void *) buf, len); + send_caller(drv_data, "call"); + return len; +} diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 84f5699890..a185b72341 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -42,7 +42,12 @@ dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1, nif_exception/1, call_nif_exception/1, nif_nan_and_inf/1, nif_atom_too_long/1, - nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1]). + nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1, + nif_now_time/1, nif_cpu_time/1, nif_unique_integer/1, + nif_is_process_alive/1, nif_is_port_alive/1, + nif_term_to_binary/1, nif_binary_to_term/1, + nif_port_command/1 + ]). -export([many_args_100/100]). @@ -72,7 +77,11 @@ all() -> otp_9668, consume_timeslice, nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception, nif_exception, nif_nan_and_inf, nif_atom_too_long, - nif_monotonic_time, nif_time_offset, nif_convert_time_unit + nif_monotonic_time, nif_time_offset, nif_convert_time_unit, + nif_now_time, nif_cpu_time, nif_unique_integer, + nif_is_process_alive, nif_is_port_alive, + nif_term_to_binary, nif_binary_to_term, + nif_port_command ]. init_per_testcase(_Case, Config) -> @@ -1365,14 +1374,16 @@ get_length(Config) when is_list(Config) -> ensure_lib_loaded(Config) -> ensure_lib_loaded(Config, 1). ensure_lib_loaded(Config, Ver) -> + Path = ?config(data_dir, Config), case lib_version() of - undefined -> - Path = proplists:get_value(data_dir, Config), - Lib = "nif_SUITE." ++ integer_to_list(Ver), - ok = erlang:load_nif(filename:join(Path,Lib), []); - Ver when is_integer(Ver) -> - ok - end. + undefined -> + Lib = "nif_SUITE." ++ integer_to_list(Ver), + ok = erlang:load_nif(filename:join(Path,Lib), []); + Ver when is_integer(Ver) -> + ok + end, + erl_ddll:try_load(Path, echo_drv, []), + ok. make_atom(Config) when is_list(Config) -> ensure_lib_loaded(Config, 1), @@ -1885,6 +1896,129 @@ chk_ctu(Time, FromTU, [ToTU|ToTUs]) -> chk_ctu(Time, FromTU, ToTUs) end. +nif_now_time(Config) -> + ensure_lib_loaded(Config), + + N1 = now(), + NifN1 = now_time(), + NifN2 = now_time(), + N2 = now(), + true = N1 < NifN1, + true = NifN1 < NifN2, + true = NifN2 < N2. + +nif_cpu_time(Config) -> + ensure_lib_loaded(Config), + + try cpu_time() of + {_, _, _} -> + ok + catch error:badarg -> + {comment, "cpu_time not supported"} + end. + +nif_unique_integer(Config) -> + ensure_lib_loaded(Config), + + UM1 = erlang:unique_integer([monotonic]), + UM2 = unique_integer_nif([monotonic]), + UM3 = erlang:unique_integer([monotonic]), + + true = UM1 < UM2, + true = UM2 < UM3, + + UMP1 = erlang:unique_integer([monotonic, positive]), + UMP2 = unique_integer_nif([monotonic, positive]), + UMP3 = erlang:unique_integer([monotonic, positive]), + + true = 0 =< UMP1, + true = UMP1 < UMP2, + true = UMP2 < UMP3, + + UP1 = erlang:unique_integer([positive]), + UP2 = unique_integer_nif([positive]), + UP3 = erlang:unique_integer([positive]), + + true = 0 =< UP1, + true = 0 =< UP2, + true = 0 =< UP3, + + true = is_integer(unique_integer_nif([])), + true = is_integer(unique_integer_nif([])), + true = is_integer(unique_integer_nif([])). + +nif_is_process_alive(Config) -> + ensure_lib_loaded(Config), + + {Pid,_} = spawn_monitor(fun() -> receive ok -> nok end end), + true = is_process_alive_nif(Pid), + exit(Pid, die), + receive _ -> ok end, %% Clear monitor + false = is_process_alive_nif(Pid). + +nif_is_port_alive(Config) -> + ensure_lib_loaded(Config), + + Port = open_port({spawn,echo_drv},[eof]), + true = is_port_alive_nif(Port), + port_close(Port), + false = is_port_alive_nif(Port). + +nif_term_to_binary(Config) -> + ensure_lib_loaded(Config), + T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + Bin = term_to_binary(T), + ct:log("~p",[Bin]), + Bin = term_to_binary_nif(T, undefined), + true = term_to_binary_nif(T, self()), + receive Bin -> ok end. + +-define(ERL_NIF_BIN2TERM_SAFE, 16#20000000). + +nif_binary_to_term(Config) -> + ensure_lib_loaded(Config), + T = {#{ok => nok}, <<0:8096>>, lists:seq(1,100)}, + Bin = term_to_binary(T), + Len = byte_size(Bin), + {Len,T} = binary_to_term_nif(Bin, undefined, 0), + Len = binary_to_term_nif(Bin, self(), 0), + T = receive M -> M after 1000 -> timeout end, + + {Len, T} = binary_to_term_nif(Bin, undefined, ?ERL_NIF_BIN2TERM_SAFE), + false = binary_to_term_nif(<<131,100,0,14,"undefined_atom">>, + undefined, ?ERL_NIF_BIN2TERM_SAFE), + false = binary_to_term_nif(Bin, undefined, 1), + ok. + +nif_port_command(Config) -> + ensure_lib_loaded(Config), + + Port = open_port({spawn,echo_drv},[eof]), + true = port_command_nif(Port, "hello\n"), + receive {Port,{data,"hello\n"}} -> ok + after 1000 -> ct:fail(timeout) end, + + RefcBin = lists:flatten([lists:duplicate(100, "hello"),"\n"]), + true = port_command_nif(Port, iolist_to_binary(RefcBin)), + receive {Port,{data,RefcBin}} -> ok + after 1000 -> ct:fail(timeout) end, + + %% Test that invalid arguments correctly returns + %% badarg and that the port survives. + {'EXIT', {badarg, _}} = (catch port_command_nif(Port, [ok])), + + IoList = [lists:duplicate(100,<<"hello">>),"\n"], + true = port_command_nif(Port, [IoList]), + FlatIoList = binary_to_list(iolist_to_binary(IoList)), + receive {Port,{data,FlatIoList}} -> ok + after 1000 -> ct:fail(timeout) end, + + port_close(Port), + + {'EXIT', {badarg, _}} = (catch port_command_nif(Port, "hello\n")), + + ok. + %% The NIFs: lib_version() -> undefined. call_history() -> ?nif_stub. @@ -1942,6 +2076,12 @@ call_dirty_nif_zero_args() -> ?nif_stub. call_nif_exception(_) -> ?nif_stub. call_nif_nan_or_inf(_) -> ?nif_stub. call_nif_atom_too_long(_) -> ?nif_stub. +unique_integer_nif(_) -> ?nif_stub. +is_process_alive_nif(_) -> ?nif_stub. +is_port_alive_nif(_) -> ?nif_stub. +term_to_binary_nif(_, _) -> ?nif_stub. +binary_to_term_nif(_, _, _) -> ?nif_stub. +port_command_nif(_, _) -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. @@ -1958,7 +2098,8 @@ sorted_list_from_maps_nif(_) -> ?nif_stub. monotonic_time(_) -> ?nif_stub. time_offset(_) -> ?nif_stub. convert_time_unit(_,_,_) -> ?nif_stub. - +now_time() -> ?nif_stub. +cpu_time() -> ?nif_stub. nif_stub_error(Line) -> exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src index ab4ff77add..fbb8978771 100644 --- a/erts/emulator/test/nif_SUITE_data/Makefile.src +++ b/erts/emulator/test/nif_SUITE_data/Makefile.src @@ -4,8 +4,7 @@ NIF_LIBS = nif_SUITE.1@dll@ \ nif_mod.2@dll@ \ nif_mod.3@dll@ -all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ - +all: $(NIF_LIBS) basic@dll@ rwlock@dll@ tsd@dll@ echo_drv@dll@ @SHLIB_RULES@ diff --git a/erts/emulator/test/nif_SUITE_data/echo_drv.c b/erts/emulator/test/nif_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..2b3510c641 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/echo_drv.c @@ -0,0 +1,62 @@ +#include <stdio.h> +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static ErlDrvSSizeT echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, unsigned *ret_flags); +static ErlDrvEntry echo_driver_entry = { + NULL, /* Init */ + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "echo_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, ErlDrvSizeT count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static ErlDrvSSizeT +echo_call(ErlDrvData drv_data, unsigned int command, + char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen, + unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 1acb270d1f..b3c6cc5ba3 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -30,6 +30,7 @@ static int static_cntA; /* zero by default */ static int static_cntB = NIF_SUITE_LIB_VER * 100; static ERL_NIF_TERM atom_false; +static ERL_NIF_TERM atom_true; static ERL_NIF_TERM atom_self; static ERL_NIF_TERM atom_ok; static ERL_NIF_TERM atom_join; @@ -138,6 +139,7 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) msgenv_dtor, ERL_NIF_RT_CREATE, NULL); atom_false = enif_make_atom(env,"false"); + atom_true = enif_make_atom(env,"true"); atom_self = enif_make_atom(env,"self"); atom_ok = enif_make_atom(env,"ok"); atom_join = enif_make_atom(env,"join"); @@ -1978,6 +1980,123 @@ static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TE return enif_make_int64(env, enif_convert_time_unit(val, from, to)); } +static ERL_NIF_TERM now_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_now_time(env); +} + +static ERL_NIF_TERM cpu_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return enif_cpu_time(env); +} + +static ERL_NIF_TERM unique_integer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM atom_pos = enif_make_atom(env,"positive"), + atom_mon = enif_make_atom(env,"monotonic"); + ERL_NIF_TERM opts = argv[0], opt; + ErlNifUniqueInteger properties = 0; + + while (!enif_is_empty_list(env, opts)) { + if (!enif_get_list_cell(env, opts, &opt, &opts)) + return enif_make_badarg(env); + + if (enif_compare(opt, atom_pos) == 0) + properties |= ERL_NIF_UNIQUE_POSITIVE; + if (enif_compare(opt, atom_mon) == 0) + properties |= ERL_NIF_UNIQUE_MONOTONIC; + } + + return enif_make_unique_integer(env, properties); +} + +static ERL_NIF_TERM is_process_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid pid; + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); + if (enif_is_process_alive(env, &pid)) + return atom_true; + return atom_false; +} + +static ERL_NIF_TERM is_port_alive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPort port; + if (!enif_get_local_port(env, argv[0], &port)) + return enif_make_badarg(env); + if (enif_is_port_alive(env, &port)) + return atom_true; + return atom_false; +} + +static ERL_NIF_TERM term_to_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary bin; + ErlNifPid pid; + ErlNifEnv *msg_env = env; + ERL_NIF_TERM term; + + if (enif_get_local_pid(env, argv[1], &pid)) + msg_env = enif_alloc_env(); + + if (!enif_term_to_binary(msg_env, argv[0], &bin)) + return enif_make_badarg(env); + + term = enif_make_binary(msg_env, &bin); + + if (msg_env != env) { + enif_send(env, &pid, msg_env, term); + enif_free_env(msg_env); + return atom_true; + } else { + return term; + } +} + +static ERL_NIF_TERM binary_to_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifBinary bin; + ERL_NIF_TERM term, ret_term; + ErlNifPid pid; + ErlNifEnv *msg_env = env; + unsigned int opts; + ErlNifUInt64 ret; + + if (enif_get_local_pid(env, argv[1], &pid)) + msg_env = enif_alloc_env(); + + if (!enif_inspect_binary(env, argv[0], &bin) + || !enif_get_uint(env, argv[2], &opts)) + return enif_make_badarg(env); + + ret = enif_binary_to_term(msg_env, bin.data, bin.size, &term, + (ErlNifBinaryToTerm)opts); + if (!ret) + return atom_false; + + ret_term = enif_make_uint64(env, ret); + if (msg_env != env) { + enif_send(env, &pid, msg_env, term); + enif_free_env(msg_env); + return ret_term; + } else { + return enif_make_tuple2(env, ret_term, term); + } +} + +static ERL_NIF_TERM port_command(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPort port; + + if (!enif_get_local_port(env, argv[0], &port)) + return enif_make_badarg(env); + + if (!enif_port_command(env, &port, NULL, argv[1])) + return enif_make_badarg(env); + return atom_true; +} + static ErlNifFunc nif_funcs[] = { {"lib_version", 0, lib_version}, @@ -2050,8 +2169,15 @@ static ErlNifFunc nif_funcs[] = {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}, {"monotonic_time", 1, monotonic_time}, {"time_offset", 1, time_offset}, - {"convert_time_unit", 3, convert_time_unit} + {"convert_time_unit", 3, convert_time_unit}, + {"now_time", 0, now_time}, + {"cpu_time", 0, cpu_time}, + {"unique_integer_nif", 1, unique_integer}, + {"is_process_alive_nif", 1, is_process_alive}, + {"is_port_alive_nif", 1, is_port_alive}, + {"term_to_binary_nif", 2, term_to_binary}, + {"binary_to_term_nif", 3, binary_to_term}, + {"port_command_nif", 2, port_command} }; ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) - diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index bbdc2e6688..3199fe9ca1 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -114,7 +114,7 @@ save_calls_1(Config) when is_list(Config) -> save_calls_1() -> erlang:process_flag(self(), save_calls, 0), {last_calls, false} = process_info(self(), last_calls), - + erlang:process_flag(self(), save_calls, 10), {last_calls, _L1} = process_info(self(), last_calls), ?MODULE:do_bipp(), @@ -132,11 +132,22 @@ save_calls_1() -> X -> ct:fail({l21, X}) end, - + erlang:process_flag(self(), save_calls, 10), {last_calls, L3} = process_info(self(), last_calls), + true = (L3 /= false), L31 = lists:filter(fun is_local_function/1, L3), [] = L31, + erlang:process_flag(self(), save_calls, 0), + + %% Also check that it works on another process ... + Pid = spawn(fun () -> receive after infinity -> ok end end), + erlang:process_flag(Pid, save_calls, 10), + {last_calls, L4} = process_info(Pid, last_calls), + true = (L4 /= false), + L41 = lists:filter(fun is_local_function/1, L4), + [] = L41, + exit(Pid,kill), ok. do_bipp() -> diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index f805e7cc64..2e7073a8f0 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -113,7 +113,6 @@ my @if_line; # my $te_max_vars = 0; # Max number of variables ever needed. my %gen_transform; -my %min_window; my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; @@ -382,7 +381,6 @@ while (<>) { $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; $obsolete[$op_num] = defined $obsolete; } else { # Unnumbered generic operation. push(@unnumbered_generic, [$name, $arity]); @@ -440,7 +438,6 @@ $num_file_opcodes = @gen_opname; $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; } } @@ -607,7 +604,7 @@ sub emulator_output { $is_transformed{$name,$arity} or error("instruction $key has no specific instruction"); $spec_op = -1 unless defined $spec_op; - &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key}); + &init_item($name, $arity, $spec_op, $num_specific, $tr); } } print "};\n"; @@ -1405,8 +1402,7 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $used_ref = used_vars($from_ref, $to_ref); - my $so_far = tr_gen_from($line, $used_ref, @$from_ref); + my $so_far = tr_gen_from($line, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1457,58 +1453,14 @@ sub tr_gen { print "};\n\n"; } -sub used_vars { - my($from_ref,$to_ref) = @_; - my %used; - my %seen; - - foreach my $ref (@$from_ref) { - my($name,$arity,@ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - # Any variable that is used at least twice on the - # left-hand side is used. (E.g. "move R R".) - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1 if $seen{$var}; - $seen{$var} = 1; - } - } - } - - foreach my $ref (@$to_ref) { - my($name, $arity, @ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1; - } - } - } - \%used; -} - sub tr_gen_from { - my($line,$used_ref,@tr) = @_; + my($line,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; my(@code); - my($min_window) = 0; - my(@fix_rest_args); - my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; - my %var_used = %$used_ref; my $may_fail = 0; my $is_first = 1; @@ -1530,8 +1482,20 @@ sub tr_gen_from { my $var; my(@args); - push(@fix_pred_funcs, scalar(@code)); - push(@code, [$name, @ops]); + foreach $var (@ops) { + error($where, "variable '$var' unbound") + unless defined $var{$var}; + if ($var_type{$var} eq 'scalar') { + push(@args, "var[$var{$var}]"); + } else { + push(@args, "rest_args"); + } + } + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + my $op = make_op("$name()", 'pred', $pi); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); next; } @@ -1544,7 +1508,6 @@ sub tr_gen_from { $opnum = $gen_opnum{$name,$arity}; push(@code, make_op("$name/$arity", 'next_instr', $opnum)); - $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; my $ignored_var = "$var (ignored)"; @@ -1593,15 +1556,21 @@ sub tr_gen_from { if (defined $var{$var}) { $ignored_var = ''; $may_fail = 1; - push(@code, &make_op($var, 'is_same_var', $var{$var})); + my $op = make_op($var, 'is_same_var', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type eq '*') { - # - # Reserve a hole for a 'rest_args' instruction. - # + foreach my $type (values %var_type) { + error("only one use of a '*' variable is " . + "allowed on the left hand side of " . + "a transformation") + if $type eq 'array'; + } $ignored_var = ''; - push(@fix_rest_args, scalar(@code)); - push(@code, $var); - } elsif ($var_used{$var}) { + $var{$var} = 'unnumbered'; + $var_type{$var} = 'array'; + push(@code, make_op($var, 'rest_args')); + } else { $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; @@ -1629,46 +1598,14 @@ sub tr_gen_from { # push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); - # - # If there is an rest_args instruction, we must insert its correct - # variable number (higher than any other). - # - my $index; - &error("only one use of a '*' variable is allowed on the left hand side of a transformation") - if @fix_rest_args > 1; - foreach $index (@fix_rest_args) { - my $var = $code[$index]; - $var{$var} = $var_num++; - $var_type{$var} = 'array'; - splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var})); - } - - foreach $index (@fix_pred_funcs) { - my($name, @ops) = @{$code[$index]}; - my(@args); - my $var; - - foreach $var (@ops) { - &error($where, "variable '$var' unbound") - unless defined $var{$var}; - if ($var_type{$var} eq 'scalar') { - push(@args, "var[$var{$var}]"); - } else { - push(@args, "var+$var{$var}"); - } - } - my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); - splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); - } - $te_max_vars = $var_num if $te_max_vars < $var_num; - [$min_window, \%var, \%var_type, \@code]; + [\%var, \%var_type, \@code]; } sub tr_gen_to { my($line, $orig_transform, $so_far, @tr) = @_; - my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far; + my($var_ref, $var_type_ref, $code_ref) = @$so_far; my(%var) = %$var_ref; my(%var_type) = %$var_type_ref; my(@code) = @$code_ref; @@ -1697,13 +1634,16 @@ sub tr_gen_to { if ($var_type{$var} eq 'scalar') { push(@args, "var[$var{$var}]"); } else { - push(@args, "var+$var{$var}"); + push(@args, "rest_args"); } } pop(@code); # Get rid of 'commit' instruction my $index = tr_next_index(\@call_table, \%call_table, $name, @args); - push(@code, make_op("$name()", 'call_end', $index)); + my $op = make_op("$name()", 'call_end', $index); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); last; } @@ -1725,11 +1665,13 @@ sub tr_gen_to { my($var, $type, $type_val) = @$op; if ($type eq '*') { - push(@code, make_op($var, 'store_rest_args', $var{$var})); + push(@code, make_op($var, 'store_rest_args')); } elsif ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); + my $op = make_op($var, 'store_var_next_arg', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { @@ -1744,6 +1686,10 @@ sub tr_gen_to { push(@code, make_op('', 'end')) unless is_instr($code[$#code], 'call_end'); + tr_maybe_keep(\@code); + tr_maybe_rename(\@code); + tr_remove_unused(\@code); + # # Chain together all codes segments having the same first operation. # @@ -1752,8 +1698,6 @@ sub tr_gen_to { my($dummy, $arity); ($dummy, $op, $arity) = @$first; my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n"; - $min_window{$key} = $min_window - if $min_window{$key} > $min_window; my $prev_last; $prev_last = pop(@{$gen_transform{$key}}) @@ -1771,6 +1715,148 @@ sub tr_gen_to { push(@{$gen_transform{$key}}, @code), } +sub tr_maybe_keep { + my($ref) = @_; + my @last_instr; + my $pos; + my $reused_instr; + + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'next_instr') { + @last_instr = ($args[0]); + } elsif ($op eq 'set_var_next_arg') { + push @last_instr, $args[0]; + } elsif ($op eq 'next_arg') { + push @last_instr, 'ignored'; + } elsif ($op eq 'new_instr') { + unless (defined $pos) { + # 'new_instr' immediately after 'commit'. + $reused_instr = $args[0]; + return unless shift(@last_instr) == $reused_instr; + $pos = $i - 1; + } else { + # Second 'new_instr' after 'commit'. The instructions + # from $pos up to and including $i - 1 rebuilds the + # existing instruction exactly. + my $name = $gen_opname[$reused_instr]; + my $arity = $gen_arity[$reused_instr]; + my $reuse = make_op("$name/$arity", 'keep'); + splice @$ref, $pos, $i-$pos, ($reuse); + return; + } + } elsif ($op eq 'store_var_next_arg') { + return unless shift(@last_instr) eq $args[0]; + } elsif (defined $pos) { + return; + } + } +} + +sub tr_maybe_rename { + my($ref) = @_; + my $s = 'left'; + my $a = 0; + my $num_args = 0; + my $new_instr; + my $first; + my $i; + + for ($i = 1; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + + if ($s eq 'left') { + if ($op eq 'set_var_next_arg') { + if ($num_args == $a and $args[0] == $a) { + $num_args++; + } + $a++; + } elsif ($op eq 'next_arg') { + $a++; + } elsif ($op eq 'commit') { + $a = 0; + $first = $i; + $s = 'committed'; + } elsif ($op eq 'next_instr') { + return; + } + } elsif ($s eq 'committed') { + if ($op eq 'new_instr') { + $new_instr = $args[0]; + $a = 0; + $s = 'right'; + } else { + return; + } + } elsif ($s eq 'right') { + if ($op eq 'store_var_next_arg' && $args[0] == $a) { + $a++; + } elsif ($op eq 'end' && $a <= $num_args) { + my $name = $gen_opname[$new_instr]; + my $arity = $gen_arity[$new_instr]; + my $new_op = make_op("$name/$arity", 'rename', $new_instr); + splice @$ref, $first, $i-$first+1, ($new_op); + return; + } else { + return; + } + } + } +} + +sub tr_remove_unused { + my($ref) = @_; + my %used; + + # Collect all used variables. + for my $instr (@$ref) { + my $uref = $$instr[3]; + for my $slot (@$uref) { + $used{$slot} = 1; + } + } + + # Replace 'set_var_next_arg' with 'next_arg' if the variable + # is never used. + for my $instr (@$ref) { + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'set_var_next_arg') { + my $var = $args[0]; + next if $used{$var}; + $instr = make_op("$comment (ignored)", 'next_arg'); + } + } + + # Delete a sequence of 'next_arg' instructions when they are + # redundant before instructions such as 'commit'. + my @opcode; + my %ending = (call_end => 1, + commit => 1, + next_instr => 1, + pred => 1, + rename => 1, + keep => 1); + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($opcode) = @$instr_ref; + + if ($ending{$opcode}) { + my $first = $i; + $first-- while $first > 0 and $opcode[$first-1] eq 'next_arg'; + my $n = $i - $first; + splice @$ref, $first, $n; + $i -= $n; + } + $opcode[$i] = $opcode; + } +} + sub tr_code_len { my($sum) = 0; my($ref); @@ -1783,7 +1869,12 @@ sub tr_code_len { sub make_op { my($comment, @op) = @_; - [scalar(@op), [@op], $comment]; + [scalar(@op), [@op], $comment, []]; +} + +sub op_slot_usage { + my($op_ref, @slots) = @_; + $$op_ref[3] = \@slots; } sub is_instr { |