diff options
Diffstat (limited to 'erts/emulator')
71 files changed, 3222 insertions, 633 deletions
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index c3ebf71a01..6b6c066211 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -154,7 +154,7 @@ static struct /* Protected by code_write_permission */ { Process* stager; ErtsThrPrgrLaterOp lop; -}commiter_state; +} committer_state; #endif static Eterm @@ -367,9 +367,9 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, * schedulers to read active code_ix in a safe way while executing * without any memory barriers at all. */ - ASSERT(commiter_state.stager == NULL); - commiter_state.stager = c_p; - erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop); + ASSERT(committer_state.stager == NULL); + committer_state.stager = c_p; + erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &committer_state.lop); erts_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); /* @@ -385,11 +385,11 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, #ifdef ERTS_SMP static void smp_code_ix_commiter(void* null) { - Process* p = commiter_state.stager; + Process* p = committer_state.stager; erts_commit_staging_code_ix(); #ifdef DEBUG - commiter_state.stager = NULL; + committer_state.stager = NULL; #endif erts_release_code_write_permission(); erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); @@ -1007,6 +1007,93 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) return 0; } +#undef in_area + +#ifdef ERTS_SMP +static void copy_literals_commit(void*); +#endif + +copy_literals_t erts_clrange = {NULL, 0}; + +/* copy literals + * + * copy_literals.ptr = LitPtr + * copy_literals.sz = LitSz + * ------ THR PROG COMMIT ----- + * + * - check process code + * - check process code + * ... + * copy_literals.ptr = NULL + * copy_literals.sz = 0 + * ------ THR PROG COMMIT ----- + * ... + */ + + +BIF_RETTYPE copy_literals_2(BIF_ALIST_2) +{ + Module* modp; + ErtsCodeIndex code_ix; + Eterm res = am_true; + + if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (!erts_try_seize_code_write_permission(BIF_P)) { + ERTS_BIF_YIELD2(bif_export[BIF_copy_literals_2], BIF_P, BIF_ARG_1, BIF_ARG_2); + } + + code_ix = erts_active_code_ix(); + + if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL || !modp->old.code_hdr) { + res = am_false; + goto done; + } + + if (BIF_ARG_2 == am_true) { + if (erts_clrange.ptr != NULL) { + res = am_aborted; + goto done; + } + erts_clrange.ptr = (Eterm*) modp->old.code_hdr->literals_start; + erts_clrange.sz = (Eterm*) modp->old.code_hdr->literals_end - erts_clrange.ptr; + } else if (BIF_ARG_2 == am_false) { + erts_clrange.ptr = NULL; + erts_clrange.sz = 0; + } + +#ifdef ERTS_SMP + ASSERT(committer_state.stager == NULL); + committer_state.stager = BIF_P; + erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop); + erts_proc_inc_refc(BIF_P); + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); +#endif +done: + erts_release_code_write_permission(); + BIF_RET(res); +} + +#ifdef ERTS_SMP +static void copy_literals_commit(void* null) { + Process* p = committer_state.stager; +#ifdef DEBUG + committer_state.stager = NULL; +#endif + erts_release_code_write_permission(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(p); +} +#endif /* ERTS_SMP */ + + BIF_RETTYPE purge_module_1(BIF_ALIST_1) { ErtsCodeIndex code_ix; diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index e989310789..e37bd4d78c 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -73,6 +73,40 @@ erts_debug_flat_size_1(BIF_ALIST_1) } } +BIF_RETTYPE +erts_debug_size_shared_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm term = BIF_ARG_1; + Uint size = size_shared(term); + + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + +BIF_RETTYPE +erts_debug_copy_shared_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm term = BIF_ARG_1; + Uint size; + Eterm* hp; + Eterm copy; + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); + + size = copy_shared_calculate(term, &info); + if (size > 0) { + hp = HAlloc(p, size); + } + copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap); + DESTROY_SHCOPY(info); + BIF_RET(copy); +} BIF_RETTYPE erts_debug_breakpoint_2(BIF_ALIST_2) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 95a22e6c54..30cc0c6814 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1914,20 +1914,7 @@ void process_main(void) if (DT_UTAG(c_p) != NIL) { if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; -#ifdef DTRACE_TAG_HARDDEBUG - if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING) - erts_fprintf(stderr, - "Dtrace -> (%T) stop spreading " - "tag %T with message %T\r\n", - c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp)); -#endif } else { -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) kill tag %T with " - "message %T\r\n", - c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp)); -#endif DT_UTAG(c_p) = NIL; SEQ_TRACE_TOKEN(c_p) = NIL; } @@ -1947,12 +1934,6 @@ void process_main(void) DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); } DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) receive tag (%T) " - "with message %T\r\n", - c_p->common.id, DT_UTAG(c_p), ERL_MESSAGE_TERM(msgp)); -#endif } else { #endif ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); @@ -1982,7 +1963,7 @@ void process_main(void) dtrace_proc_str(c_p, receiver_name); token2 = SEQ_TRACE_TOKEN(c_p); - if (token2 != NIL && token2 != am_have_dt_utag) { + if (have_seqtrace(token2)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 410a6cecac..bb9165cd79 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2042,11 +2042,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); - if (SEQ_TRACE_TOKEN(p) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(p) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(p))) { seq_trace_update_send(p); seq_trace_output(SEQ_TRACE_TOKEN(p), msg, SEQ_TRACE_SEND, portid, p); @@ -4241,6 +4237,7 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) goto bad; enp = erts_find_or_insert_node(dep->sysname, dep->creation); + ASSERT(enp != erts_this_node); etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1); etp->header = make_external_pid_header(1); diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 65f8d6f1f5..c49a3ff313 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -639,14 +639,17 @@ bif ets:update_counter/4 bif erts_debug:map_info/1 # -# Obsolete +# New in 19.0 # -bif erlang:hash/2 +bif erlang:copy_literals/2 +bif binary:split/2 +bif binary:split/3 +bif erts_debug:size_shared/1 +bif erts_debug:copy_shared/1 # -# New in 19.0 +# Obsolete # -bif binary:split/2 -bif binary:split/3 +bif erlang:hash/2 diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index f27c526413..67a96f6442 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -75,8 +75,14 @@ Uint size_object(Eterm obj) Uint sum = 0; Eterm* ptr; int arity; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); +#endif DECLARE_ESTACK(s); + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size_object %p\n", mypid, obj)); + for (;;) { switch (primary_tag(obj)) { case TAG_PRIMARY_LIST: @@ -211,6 +217,7 @@ Uint size_object(Eterm obj) pop_next: if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum)); return sum; } obj = ESTACK_POP(s); @@ -222,9 +229,377 @@ Uint size_object(Eterm obj) } /* + * Machinery for sharing preserving information + * Using a WSTACK but not very transparently; consider refactoring + */ + +#define DECLARE_BITSTORE(s) \ + DECLARE_WSTACK(s); \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + int WSTK_CONCAT(s,_offset) = 0; \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DESTROY_BITSTORE(s) DESTROY_WSTACK(s) +#define BITSTORE_PUT(s,i) \ +do { \ + WSTK_CONCAT(s,_buffer) |= i << WSTK_CONCAT(s,_bitoffs); \ + WSTK_CONCAT(s,_bitoffs) += 2; \ + if (WSTK_CONCAT(s,_bitoffs) >= 8*sizeof(UWord)) { \ + WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \ + WSTK_CONCAT(s,_bitoffs) = 0; \ + WSTK_CONCAT(s,_buffer) = 0; \ + } \ +} while(0) +#define BITSTORE_CLOSE(s) \ +do { \ + if (WSTK_CONCAT(s,_bitoffs) > 0) { \ + WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \ + WSTK_CONCAT(s,_bitoffs) = 0; \ + } \ +} while(0) + +#define BITSTORE_FETCH(s,dst) \ +do { \ + UWord result; \ + if (WSTK_CONCAT(s,_bitoffs) <= 0) { \ + WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \ + WSTK_CONCAT(s,_offset)++; \ + WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \ + } \ + WSTK_CONCAT(s,_bitoffs) -= 2; \ + result = WSTK_CONCAT(s,_buffer) & 3; \ + WSTK_CONCAT(s,_buffer) >>= 2; \ + (dst) = result; \ +} while(0) + +#define BOXED_VISITED_MASK ((Eterm) 3) +#define BOXED_VISITED ((Eterm) 1) +#define BOXED_SHARED_UNPROCESSED ((Eterm) 2) +#define BOXED_SHARED_PROCESSED ((Eterm) 3) + +#define COUNT_OFF_HEAP (0) + +#define IN_LITERAL_PURGE_AREA(info, ptr) \ + ((info)->range_ptr && ( \ + (info)->range_ptr <= (ptr) && \ + (ptr) < ((info)->range_ptr + (info)->range_sz))) +/* + * Return the real size of an object and find sharing information + * This currently returns the same as erts_debug:size/1. + * It is argued whether the size of subterms in constant pools + * should be counted or not. + */ + +Uint size_shared(Eterm obj) +{ + Eterm saved_obj = obj; + Uint sum = 0; + Eterm* ptr; + + DECLARE_EQUEUE(s); + DECLARE_BITSTORE(b); + + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + /* we're not counting anything that's outside our heap */ + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto pop_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it's visited, don't count it */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER || + primary_tag(head) == TAG_PRIMARY_HEADER) { + goto pop_next; + } + /* else make it visited now */ + switch (primary_tag(tail)) { + case TAG_PRIMARY_LIST: + ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; + break; + case TAG_PRIMARY_IMMED1: + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); + break; + case TAG_PRIMARY_BOXED: + BITSTORE_PUT(b, primary_tag(head)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; + break; + } + /* and count it */ + sum += 2; + if (!IS_CONST(head)) { + EQUEUE_PUT(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + /* we're not counting anything that's outside our heap */ + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto pop_next; + } + hdr = *ptr; + /* if it's visited, don't count it */ + if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { + goto pop_next; + } + /* else make it visited now */ + *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; + /* and count it */ + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + goto pop_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + sum += 1 /* header */ + sz + eterms; + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Uint extra_bytes; + Eterm hdr; + ASSERT((sb->thing_word & ~BOXED_VISITED_MASK) == HEADER_SUB_BIN); + if (sb->bitsize + sb->bitoffs > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if (sb->bitsize + sb->bitoffs > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + ptr = binary_val(sb->orig); + hdr = (*ptr) & ~BOXED_VISITED_MASK; + if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { + sum += PROC_BIN_SIZE; + } else { + ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG); + sum += heap_bin_size(binary_size(obj) + extra_bytes); + } + goto pop_next; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t*)flatmap_val(obj); + Uint n = flatmap_get_size(mp) + 1; + ptr = (Eterm *)mp; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "size_shared: matchstate term not allowed"); + default: + sum += thing_arityval(hdr) + 1; + goto pop_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + pop_next: + if (EQUEUE_ISEMPTY(s)) { + goto cleanup; + } + obj = EQUEUE_GET(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + } + +cleanup: + obj = saved_obj; + BITSTORE_CLOSE(b); + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto cleanup_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if not already clean, clean it up */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER) { + if (primary_tag(head) == TAG_PRIMARY_HEADER) { + Eterm saved; + BITSTORE_FETCH(b, saved); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED; + } else { + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_LIST; + } + } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); + CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; + } else { + goto cleanup_next; + } + /* and its children too */ + if (!IS_CONST(head)) { + EQUEUE_PUT_UNCHECKED(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) { + goto cleanup_next; + } + hdr = *ptr; + /* if not already clean, clean it up */ + if (primary_tag(hdr) == TAG_PRIMARY_HEADER) { + goto cleanup_next; + } + else { + ASSERT(primary_tag(hdr) == BOXED_VISITED); + *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + } + /* and its children too */ + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + if (arity == 0) { /* Empty tuple -- unusual. */ + goto cleanup_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT_UNCHECKED(s, obj); + } + } + goto cleanup_next; + } + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + default: + goto cleanup_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + cleanup_next: + if (EQUEUE_ISEMPTY(s)) { + goto all_clean; + } + obj = EQUEUE_GET(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + } + + all_clean: + /* Return the result */ + DESTROY_EQUEUE(s); + DESTROY_BITSTORE(b); + return sum; +} + + +/* * Copy a structure to a heap. */ -Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz) { char* hstart; Uint hsize; @@ -239,19 +614,23 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) Eterm* argp; Eterm* const_tuple; Eterm hdr; + Eterm *hend; int i; #ifdef DEBUG Eterm org_obj = obj; Uint org_sz = sz; + Eterm mypid = erts_get_current_pid(); #endif if (IS_CONST(obj)) return obj; + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_struct %p\n", mypid, obj)); + DTRACE1(copy_struct, (int32_t)sz); hp = htop = *hpp; - hbot = htop + sz; + hbot = hend = htop + sz; hstart = (char *)htop; hsize = (char*) hbot - hstart; const_tuple = 0; @@ -516,22 +895,870 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) } } + if (bsz) { + *hpp = htop; + *bsz = hend - hbot; + } else { #ifdef DEBUG - if (htop != hbot) - erl_exit(ERTS_ABORT_EXIT, - "Internal error in copy_struct() when copying %T:" - " htop=%p != hbot=%p (sz=%beu)\n", - org_obj, htop, hbot, org_sz); + if (htop != hbot) + erl_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct() when copying %T:" + " htop=%p != hbot=%p (sz=%beu)\n", + org_obj, htop, hbot, org_sz); #else - if (htop > hbot) { - erl_exit(ERTS_ABORT_EXIT, - "Internal error in copy_struct(): htop, hbot overrun\n"); - } + if (htop > hbot) { + erl_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct(): htop, hbot overrun\n"); + } #endif - *hpp = (Eterm *) (hstart+hsize); + *hpp = (Eterm *) (hstart+hsize); + } + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res)); return res; } + +/* + * Machinery for the table used by the sharing preserving copier + * Using an ESTACK but not very transparently; consider refactoring + */ + +#define DECLARE_SHTABLE(s) \ + DECLARE_ESTACK(s); \ + Uint ESTK_CONCAT(s,_offset) = 0 +#define DESTROY_SHTABLE(s) DESTROY_ESTACK(s) +#define SHTABLE_INCR 4 +#define SHTABLE_NEXT(s) ESTK_CONCAT(s,_offset) +#define SHTABLE_PUSH(s,x,y,b) \ +do { \ + if (s.sp > s.end - SHTABLE_INCR) { \ + erl_grow_estack(&(s), SHTABLE_INCR); \ + } \ + *s.sp++ = (x); \ + *s.sp++ = (y); \ + *s.sp++ = (Eterm) NULL; \ + *s.sp++ = (Eterm) (b); \ + ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \ +} while(0) +#define SHTABLE_X(s,e) (s.start[e]) +#define SHTABLE_Y(s,e) (s.start[(e)+1]) +#define SHTABLE_FWD(s,e) ((Eterm *) (s.start[(e)+2])) +#define SHTABLE_FWD_UPD(s,e,p) (s.start[(e)+2] = (Eterm) (p)) +#define SHTABLE_REV(s,e) ((Eterm *) (s.start[(e)+3])) + +#define LIST_SHARED_UNPROCESSED ((Eterm) 0) +#define LIST_SHARED_PROCESSED ((Eterm) 1) + +#define HEAP_ELEM_TO_BE_FILLED _unchecked_make_list(NULL) + + +/* + * Specialized macros for using/reusing the persistent state + */ + +#define DECLARE_EQUEUE_INIT_INFO(q, info) \ + UWord* EQUE_DEF_QUEUE(q) = info->queue_default; \ + ErtsEQueue q = { \ + EQUE_DEF_QUEUE(q), /* start */ \ + EQUE_DEF_QUEUE(q), /* front */ \ + EQUE_DEF_QUEUE(q), /* back */ \ + 1, /* possibly_empty */ \ + EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } + +#define DECLARE_EQUEUE_FROM_INFO(q, info) \ + /* no EQUE_DEF_QUEUE(q), read-only */ \ + ErtsEQueue q = { \ + info->queue_start, /* start */ \ + info->queue_start, /* front */ \ + info->queue_start, /* back */ \ + 1, /* possibly_empty */ \ + info->queue_end, /* end */ \ + info->queue_alloc_type /* alloc_type */ \ + } + +#define DECLARE_BITSTORE_INIT_INFO(s, info) \ + UWord* WSTK_DEF_STACK(s) = info->bitstore_default; \ + ErtsWStack s = { \ + WSTK_DEF_STACK(s), /* wstart */ \ + WSTK_DEF_STACK(s), /* wsp */ \ + WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \ + WSTK_DEF_STACK(s), /* wdflt */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + }; \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + /* no WSTK_CONCAT(s,_offset), write-only */ \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DECLARE_BITSTORE_FROM_INFO(s, info) \ + /* no WSTK_DEF_STACK(s), read-only */ \ + ErtsWStack s = { \ + info->bitstore_start, /* wstart */ \ + NULL, /* wsp, read-only */ \ + NULL, /* wend, read-only */ \ + NULL, /* wdef, read-only */ \ + info->bitstore_alloc_type /* alloc_type */ \ + }; \ + int WSTK_CONCAT(s,_bitoffs) = 0; \ + int WSTK_CONCAT(s,_offset) = 0; \ + UWord WSTK_CONCAT(s,_buffer) = 0 + +#define DECLARE_SHTABLE_INIT_INFO(s, info) \ + Eterm* ESTK_DEF_STACK(s) = info->shtable_default; \ + ErtsEStack s = { \ + ESTK_DEF_STACK(s), /* start */ \ + ESTK_DEF_STACK(s), /* sp */ \ + ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \ + ESTK_DEF_STACK(s), /* default */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + }; \ + Uint ESTK_CONCAT(s,_offset) = 0 + +#define DECLARE_SHTABLE_FROM_INFO(s, info) \ + /* no ESTK_DEF_STACK(s), read-only */ \ + ErtsEStack s = { \ + info->shtable_start, /* start */ \ + NULL, /* sp, read-only */ \ + NULL, /* end, read-only */ \ + NULL, /* def, read-only */ \ + info->shtable_alloc_type /* alloc_type */ \ + }; \ + /* no ESTK_CONCAT(s,_offset), read-only */ + +/* + * Copy object "obj" preserving sharing. + * First half: count size and calculate sharing. + */ +Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) +{ + Uint sum; + Uint e; + unsigned sz; + Eterm* ptr; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); +#endif + + DECLARE_EQUEUE_INIT_INFO(s, info); + DECLARE_BITSTORE_INIT_INFO(b, info); + DECLARE_SHTABLE_INIT_INFO(t, info); + + /* step #0: + ------------------------------------------------------- + get rid of the easy cases first: + - copying constants + - if not a proper process, do flat copy + */ + + if (IS_CONST(obj)) + return 0; + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", mypid, obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", mypid, obj)); + + /* step #1: + ------------------------------------------------------- + traverse the term and calculate the size; + when traversing, transform as you do in size_shared + but when you find shared objects: + + a. add entry in the table, indexed by i + b. mark them: + b1. boxed terms, set header to (i | 11) + store (old header, NONV, NULL, backptr) in the entry + b2. cons cells, set CDR to NONV, set CAR to i + store (old CAR, old CDR, NULL, backptr) in the entry + */ + + sum = 0; + + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + /* off heap list pointers are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj)); + if (IN_LITERAL_PURGE_AREA(info,ptr)) + info->literal_size += size_object(obj); + goto pop_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it's visited, don't count it; + if not already shared, make it shared and store it in the table */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER || + primary_tag(head) == TAG_PRIMARY_HEADER) { + if (tail != THE_NON_VALUE) { + e = SHTABLE_NEXT(t); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", mypid, ptr)); + SHTABLE_PUSH(t, head, tail, ptr); + CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED; + CDR(ptr) = THE_NON_VALUE; + } + goto pop_next; + } + /* else make it visited now */ + switch (primary_tag(tail)) { + case TAG_PRIMARY_LIST: + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", mypid, ptr)); + CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER; + break; + case TAG_PRIMARY_IMMED1: + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", mypid, ptr)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head); + break; + case TAG_PRIMARY_BOXED: + BITSTORE_PUT(b, primary_tag(head)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", mypid, ptr)); + CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER; + CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER; + break; + } + /* and count it */ + sum += 2; + if (!IS_CONST(head)) { + EQUEUE_PUT(s, head); + } + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + /* off heap pointers to boxes are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj)); + if (IN_LITERAL_PURGE_AREA(info,ptr)) + info->literal_size += size_object(obj); + goto pop_next; + } + hdr = *ptr; + /* if it's visited, don't count it; + if not already shared, make it shared and store it in the table */ + if (primary_tag(hdr) != TAG_PRIMARY_HEADER) { + if (primary_tag(hdr) == BOXED_VISITED) { + e = SHTABLE_NEXT(t); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", mypid, ptr)); + SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr); + *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED; + } + goto pop_next; + } + /* else make it visited now */ + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", mypid, ptr)); + *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED; + /* and count it */ + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + goto pop_next; + } + while (arity-- > 0) { + obj = *++ptr; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + sz = thing_arityval(hdr); + sum += 1 /* header */ + sz + eterms; + ptr += 1 /* header */ + sz; + while (eterms-- > 0) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb->bitsize; + size_t size = sb->size; + Uint extra_bytes; + Eterm hdr; + if (bit_size + bit_offset > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if (bit_size + bit_offset > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + ASSERT(is_boxed(real_bin) && + (((*boxed_val(real_bin)) & + (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) + == _TAG_HEADER_REFC_BIN)); + hdr = *_unchecked_binary_val(real_bin) & ~BOXED_VISITED_MASK; + if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) { + sum += heap_bin_size(size+extra_bytes); + } else { + ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG); + sum += PROC_BIN_SIZE; + } + goto pop_next; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + sum += n + 2; + ptr += 2; /* hdr + size words */ + while (n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + sum += 1 + n + header_arity(hdr); + ptr += 1 + header_arity(hdr); + + if (n == 0) { + goto pop_next; + } + while(n--) { + obj = *ptr++; + if (!IS_CONST(obj)) { + EQUEUE_PUT(s, obj); + } + } + goto pop_next; + } + default: + erl_exit(ERTS_ABORT_EXIT, "copy_shared_calculate: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "size_shared: matchstate term not allowed"); + default: + sum += thing_arityval(hdr) + 1; + goto pop_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + pop_next: + if (EQUEUE_ISEMPTY(s)) { + /* add sentinel to the table */ + SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL); + /* store persistent info */ + BITSTORE_CLOSE(b); + info->queue_start = s.start; + info->queue_end = s.end; + info->queue_alloc_type = s.alloc_type; + info->bitstore_start = b.wstart; + info->bitstore_alloc_type = b.alloc_type; + info->shtable_start = t.start; + info->shtable_alloc_type = t.alloc_type; + /* single point of return: the size of the object */ + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum)); + return sum + info->literal_size; + } + obj = EQUEUE_GET(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj); + } + } +} + +/* + * Copy object "obj" preserving sharing. + * Second half: copy and restore the object. + */ +Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, + Eterm** hpp, ErlOffHeap* off_heap) { + Uint e; + unsigned sz; + Eterm* ptr; + Eterm* hp; + Eterm* hscan; + Eterm result; + Eterm* resp; + Eterm *hbot, *hend; + unsigned remaining; +#ifdef DEBUG + Eterm mypid = erts_get_current_pid(); + Eterm saved_obj = obj; +#endif + + DECLARE_EQUEUE_FROM_INFO(s, info); + DECLARE_BITSTORE_FROM_INFO(b, info); + DECLARE_SHTABLE_FROM_INFO(t, info); + + /* step #0: + ------------------------------------------------------- + get rid of the easy cases first: + - copying constants + - if not a proper process, do flat copy + */ + + if (IS_CONST(obj)) + return obj; + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj)); + + /* step #2: was performed before this function was called + ------------------------------------------------------- + allocate new space + */ + + hscan = hp = *hpp; + hbot = hend = hp + size; + + /* step #3: + ------------------------------------------------------- + traverse the term a second time and when traversing: + a. if the object is marked as shared + a1. if the entry contains a forwarding ptr, use that + a2. otherwise, copy it to the new space and store the + forwarding ptr to the entry + b. otherwise, reverse-transform as you do in size_shared + and copy to the new space + */ + + resp = &result; + remaining = 0; + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm head, tail; + ptr = list_val(obj); + /* off heap list pointers are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + *resp = obj; + } else { + Uint bsz = 0; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; + } + goto cleanup_next; + } + head = CAR(ptr); + tail = CDR(ptr); + /* if it is shared */ + if (tail == THE_NON_VALUE) { + e = head >> _TAG_PRIMARY_SIZE; + /* if it has been processed, just use the forwarding pointer */ + if (primary_tag(head) == LIST_SHARED_PROCESSED) { + *resp = make_list(SHTABLE_FWD(t, e)); + goto cleanup_next; + } + /* else, let's process it now, + copy it and keep the forwarding pointer */ + else { + CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED; + head = SHTABLE_X(t, e); + tail = SHTABLE_Y(t, e); + ptr = &(SHTABLE_X(t, e)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", mypid, ptr, SHTABLE_REV(t, e))); + SHTABLE_FWD_UPD(t, e, hp); + } + } + /* if not already clean, clean it up and copy it */ + if (primary_tag(tail) == TAG_PRIMARY_HEADER) { + if (primary_tag(head) == TAG_PRIMARY_HEADER) { + Eterm saved; + BITSTORE_FETCH(b, saved); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr)); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved; + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED; + } else { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr)); + CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST; + } + } else if (primary_tag(head) == TAG_PRIMARY_HEADER) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", mypid, ptr)); + CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail); + CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1; + } else { + ASSERT(0 && "cannot come here"); + goto cleanup_next; + } + /* and its children too */ + if (IS_CONST(head)) { + CAR(hp) = head; + } else { + EQUEUE_PUT_UNCHECKED(s, head); + CAR(hp) = HEAP_ELEM_TO_BE_FILLED; + } + *resp = make_list(hp); + resp = &(CDR(hp)); + hp += 2; + obj = tail; + break; + } + case TAG_PRIMARY_BOXED: { + Eterm hdr; + ptr = boxed_val(obj); + /* off heap pointers to boxes are copied verbatim */ + if (erts_is_literal(obj,ptr)) { + if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + *resp = obj; + } else { + Uint bsz = 0; + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + hbot -= bsz; + } + goto cleanup_next; + } + hdr = *ptr; + /* clean it up, unless it's already clean or shared and processed */ + switch (primary_tag(hdr)) { + case TAG_PRIMARY_HEADER: + ASSERT(0 && "cannot come here"); + /* if it is shared and has been processed, + just use the forwarding pointer */ + case BOXED_SHARED_PROCESSED: + e = hdr >> _TAG_PRIMARY_SIZE; + *resp = make_boxed(SHTABLE_FWD(t, e)); + goto cleanup_next; + /* if it is shared but has not been processed yet, let's process + it now: copy it and keep the forwarding pointer */ + case BOXED_SHARED_UNPROCESSED: + e = hdr >> _TAG_PRIMARY_SIZE; + *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED; + hdr = SHTABLE_X(t, e); + ASSERT(primary_tag(hdr) == BOXED_VISITED); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", mypid, ptr, SHTABLE_REV(t, e))); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr)); + SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + SHTABLE_FWD_UPD(t, e, hp); + break; + case BOXED_VISITED: + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr)); + *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER; + break; + } + /* and its children too */ + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + int arity = header_arity(hdr); + *resp = make_boxed(hp); + *hp++ = hdr; + while (arity-- > 0) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) ptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + sz = thing_arityval(hdr); + funp = (ErlFunThing *) hp; + *resp = make_fun(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + while (eterms-- > 0) { + obj = *ptr++; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + funp->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*) funp; + erts_refc_inc(&funp->fe->refc, 2); + goto cleanup_next; + } + case MAP_SUBTAG: + *resp = make_flatmap(hp); + *hp++ = hdr; + switch (MAP_HEADER_TYPE(hdr)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) ptr; + Uint n = flatmap_get_size(mp) + 1; + *hp++ = *++ptr; /* keys */ + while (n--) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + *hp++ = *++ptr; /* total map size */ + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : { + Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + while (n--) { + obj = *++ptr; + if (IS_CONST(obj)) { + *hp++ = obj; + } else { + EQUEUE_PUT_UNCHECKED(s, obj); + *hp++ = HEAP_ELEM_TO_BE_FILLED; + } + } + goto cleanup_next; + } + default: + erl_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr)); + } + case REFC_BINARY_SUBTAG: { + ProcBin* pb = (ProcBin *) ptr; + sz = thing_arityval(hdr); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + pb = (ProcBin *) hp; + *resp = make_binary(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + erts_refc_inc(&pb->val->refc, 2); + pb->next = off_heap->first; + pb->flags = 0; + off_heap->first = (struct erl_off_heap_header*) pb; + OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm)); + goto cleanup_next; + } + case SUB_BINARY_SUBTAG: { + ErlSubBin* sb = (ErlSubBin *) ptr; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb->bitsize; + Uint offset = sb->offs; + size_t size = sb->size; + Uint extra_bytes; + Uint real_size; + if ((bit_size + bit_offset) > 8) { + extra_bytes = 2; + } else if ((bit_size + bit_offset) > 0) { + extra_bytes = 1; + } else { + extra_bytes = 0; + } + real_size = size+extra_bytes; + ASSERT(is_boxed(real_bin) && + (((*boxed_val(real_bin)) & + (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK)) + == _TAG_HEADER_REFC_BIN)); + ptr = _unchecked_binary_val(real_bin); + *resp = make_binary(hp); + if (extra_bytes != 0) { + ErlSubBin* res = (ErlSubBin *) hp; + hp += ERL_SUB_BIN_SIZE; + res->thing_word = HEADER_SUB_BIN; + res->size = size; + res->bitsize = bit_size; + res->bitoffs = bit_offset; + res->offs = 0; + res->is_writable = 0; + res->orig = make_binary(hp); + } + if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) { + ErlHeapBin* from = (ErlHeapBin *) ptr; + ErlHeapBin* to = (ErlHeapBin *) hp; + hp += heap_bin_size(real_size); + to->thing_word = header_heap_bin(real_size); + to->size = real_size; + sys_memcpy(to->data, ((byte *)from->data)+offset, real_size); + } else { + ProcBin* from = (ProcBin *) ptr; + ProcBin* to = (ProcBin *) hp; + ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG); + if (from->flags) { + erts_emasculate_writable_binary(from); + } + hp += PROC_BIN_SIZE; + to->thing_word = HEADER_PROC_BIN; + to->size = real_size; + to->val = from->val; + erts_refc_inc(&to->val->refc, 2); + to->bytes = from->bytes + offset; + to->next = off_heap->first; + to->flags = 0; + off_heap->first = (struct erl_off_heap_header*) to; + OH_OVERHEAD(off_heap, to->size / sizeof(Eterm)); + } + goto cleanup_next; + } + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: { + ExternalThing *etp = (ExternalThing *) hp; + sz = thing_arityval(hdr); + *resp = make_external(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + etp->next = off_heap->first; + off_heap->first = (struct erl_off_heap_header*) etp; + erts_refc_inc(&etp->node->refc, 2); + goto cleanup_next; + } + default: + sz = thing_arityval(hdr); + *resp = make_boxed(hp); + *hp++ = hdr; + ptr++; + while (sz-- > 0) { + *hp++ = *ptr++; + } + goto cleanup_next; + } + break; + } + case TAG_PRIMARY_IMMED1: + *resp = obj; + cleanup_next: + if (EQUEUE_ISEMPTY(s)) { + goto all_clean; + } + obj = EQUEUE_GET(s); + for (;;) { + ASSERT(hscan < hp); + if (remaining == 0) { + if (*hscan == HEAP_ELEM_TO_BE_FILLED) { + resp = hscan; + hscan += 2; + break; /* scanning loop */ + } else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) { + switch (*hscan & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + remaining = header_arity(*hscan); + hscan++; + break; + case FUN_SUBTAG: { + ErlFunThing* funp = (ErlFunThing *) hscan; + hscan += 1 + thing_arityval(*hscan); + remaining = 1 + funp->num_free; + break; + } + case MAP_SUBTAG: + switch (MAP_HEADER_TYPE(*hscan)) { + case MAP_HEADER_TAG_FLATMAP_HEAD : { + flatmap_t *mp = (flatmap_t *) hscan; + remaining = flatmap_get_size(mp) + 1; + hscan += 2; + break; + } + case MAP_HEADER_TAG_HAMT_HEAD_BITMAP : + case MAP_HEADER_TAG_HAMT_HEAD_ARRAY : + case MAP_HEADER_TAG_HAMT_NODE_BITMAP : + remaining = hashmap_bitcount(MAP_HEADER_VAL(*hscan)); + hscan += MAP_HEADER_ARITY(*hscan) + 1; + break; + default: + erl_exit(ERTS_ABORT_EXIT, + "copy_shared_perform: bad hashmap type %d\n", + MAP_HEADER_TYPE(*hscan)); + } + break; + case SUB_BINARY_SUBTAG: + ASSERT(((ErlSubBin *) hscan)->bitoffs + + ((ErlSubBin *) hscan)->bitsize > 0); + hscan += ERL_SUB_BIN_SIZE; + break; + default: + hscan += 1 + thing_arityval(*hscan); + break; + } + } else { + hscan++; + } + } else if (*hscan == HEAP_ELEM_TO_BE_FILLED) { + resp = hscan++; + remaining--; + break; /* scanning loop */ + } else { + hscan++; + remaining--; + } + } + ASSERT(resp < hp); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj); + } + } + + /* step #4: + ------------------------------------------------------- + traverse the table and reverse-transform all stored entries + */ + +all_clean: + for (e = 0; ; e += SHTABLE_INCR) { + ptr = SHTABLE_REV(t, e); + if (ptr == NULL) + break; + VERBOSE(DEBUG_SHCOPY, ("[copy] restoring shared: %x\n", ptr)); + /* entry was a list */ + if (SHTABLE_Y(t, e) != THE_NON_VALUE) { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", mypid, ptr)); + CAR(ptr) = SHTABLE_X(t, e); + CDR(ptr) = SHTABLE_Y(t, e); + } + /* entry was boxed */ + else { + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", mypid, ptr)); + *ptr = SHTABLE_X(t, e); + ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER); + } + } + +#ifdef DEBUG + if (eq(saved_obj, result) == 0) { + erts_fprintf(stderr, "original = %T\n", saved_obj); + erts_fprintf(stderr, "copy = %T\n", result); + erl_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n"); + } +#endif + + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", mypid, saved_obj)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", mypid, result)); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, result)); + + ASSERT(hbot == hp); + ASSERT(size == ((hp - *hpp) + (hend - hbot))); + *hpp = hend; + return result; +} + + /* * Copy a term that is guaranteed to be contained in a single * heap block. The heap block is copied word by word, and any diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 68745fc448..d5443476ec 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -881,11 +881,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) DTRACE_CHARBUF(receiver_name, 64); #endif - if (SEQ_TRACE_TOKEN(sender) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { seq_trace_update_send(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender); @@ -900,7 +896,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "%T", remote); msize = size_object(message); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -942,11 +938,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, DTRACE_CHARBUF(receiver_name, 128); #endif - if (SEQ_TRACE_TOKEN(sender) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag -#endif - ) { + if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { seq_trace_update_send(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender); @@ -961,7 +953,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), "{%T,%s}", remote_name, node_name); msize = size_object(message); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -1006,11 +998,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, #endif UseTmpHeapNoproc(6); - if (token != NIL -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - ) { + if (have_seqtrace(token)) { seq_trace_update_send(dsdp->proc); seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local); ctl = TUPLE5(&ctl_heap[0], @@ -1029,7 +1017,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, "{%T,%s}", remote, node_name); erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)), "%T", reason); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -2571,7 +2559,9 @@ int distribution_info(int to, void *arg) /* Called by break handler */ } for (dep = erts_not_connected_dist_entries; dep; dep = dep->next) { - info_dist_entry(to, arg, dep, 0, 0); + if (dep != erts_this_dist_entry) { + info_dist_entry(to, arg, dep, 0, 0); + } } return(0); @@ -2649,13 +2639,8 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) if (!net_kernel) goto error; - /* By setting dist_entry==erts_this_dist_entry and DISTRIBUTION on - net_kernel do_net_exist will be called when net_kernel - is terminated !! */ - (void) ERTS_PROC_SET_DIST_ENTRY(net_kernel, - ERTS_PROC_LOCK_MAIN, - erts_this_dist_entry); - erts_refc_inc(&erts_this_dist_entry->refc, 2); + /* By setting F_DISTRIBUTION on net_kernel, + * do_net_exist will be called when net_kernel is terminated !! */ net_kernel->flags |= F_DISTRIBUTION; if (net_kernel != BIF_P) @@ -3016,11 +3001,11 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); - ASSERT(erts_no_of_not_connected_dist_entries >= 0); + ASSERT(erts_no_of_not_connected_dist_entries > 0); ASSERT(erts_no_of_hidden_dist_entries >= 0); ASSERT(erts_no_of_visible_dist_entries >= 0); if(not_connected) - length += erts_no_of_not_connected_dist_entries; + length += (erts_no_of_not_connected_dist_entries - 1); if(hidden) length += erts_no_of_hidden_dist_entries; if(visible) @@ -3042,8 +3027,10 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) #endif if(not_connected) for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) { - result = CONS(hp, dep->sysname, result); - hp += 2; + if (dep != erts_this_dist_entry) { + result = CONS(hp, dep->sysname, result); + hp += 2; + } } if(hidden) for(dep = erts_hidden_dist_entries; dep; dep = dep->next) { diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 5574a3b713..5544712e8d 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -131,6 +131,7 @@ static ErtsAllocatorState_t ets_alloc_state; static ErtsAllocatorState_t driver_alloc_state; static ErtsAllocatorState_t fix_alloc_state; static ErtsAllocatorState_t literal_alloc_state; +static ErtsAllocatorState_t test_alloc_state; typedef struct { erts_smp_atomic32_t refc; @@ -213,6 +214,7 @@ typedef struct { struct au_init driver_alloc; struct au_init fix_alloc; struct au_init literal_alloc; + struct au_init test_alloc; } erts_alc_hndl_args_init_t; #define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} @@ -445,6 +447,33 @@ set_default_fix_alloc_opts(struct au_init *ip, ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; } +static void +set_default_test_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = 0; /* Disabled by default */ + ip->thr_spec = -1 * erts_no_schedulers; + ip->atype = AOFIRSTFIT; + ip->init.aoff.flavor = AOFF_BF; + ip->init.util.name_prefix = "test_"; + ip->init.util.alloc_no = ERTS_ALC_A_TEST; + ip->init.util.mmbcs = 0; /* Main carrier size */ + ip->init.util.ts = ERTS_ALC_MTA_TEST; + ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; + + /* Use a constant minimal MBC size */ +#if ERTS_SA_MB_CARRIERS + ip->init.util.smbcs = ERTS_SACRR_UNIT_SZ; + ip->init.util.lmbcs = ERTS_SACRR_UNIT_SZ; + ip->init.util.sbct = ERTS_SACRR_UNIT_SZ; +#else + ip->init.util.smbcs = 1 << 12; + ip->init.util.lmbcs = 1 << 12; + ip->init.util.sbct = 1 << 12; +#endif +} + + #ifdef ERTS_SMP static void @@ -625,6 +654,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_default_fix_alloc_opts(&init.fix_alloc, fix_type_sizes); set_default_literal_alloc_opts(&init.literal_alloc); + set_default_test_alloc_opts(&init.test_alloc); if (argc && argv) handle_args(argc, argv, &init); @@ -776,6 +806,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu); set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu); set_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, ncpu); + set_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, ncpu); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { if (!erts_allctrs[i].alloc) @@ -832,6 +863,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) &init.literal_alloc, &literal_alloc_state); + start_au_allocator(ERTS_ALC_A_TEST, + &init.test_alloc, + &test_alloc_state); + erts_mtrace_install_wrapper_functions(); extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); @@ -1412,6 +1447,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) &init->fix_alloc, &init->sl_alloc, &init->temp_alloc + /* test_alloc not affected by +Mea??? or +Mu??? */ }; int aui_sz = (int) sizeof(aui)/sizeof(aui[0]); char *arg; @@ -1502,6 +1538,9 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) case 'T': handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i, 0); break; + case 'Z': + handle_au_arg(&init->test_alloc, &argv[i][3], argv, &i, 0); + break; case 'Y': { /* sys_alloc */ if (has_prefix("tt", param+2)) { /* set trim threshold */ @@ -2154,11 +2193,12 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) return am_badarg; } - /* All alloc_util allocators *have* to be enabled */ + /* All alloc_util allocators *have* to be enabled, except test_alloc */ for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) { switch (ai) { case ERTS_ALC_A_SYSTEM: + case ERTS_ALC_A_TEST: break; default: if (!erts_allctrs_info[ai].enabled @@ -2199,6 +2239,8 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) * contain any allocated memory. */ continue; + case ERTS_ALC_A_TEST: + continue; case ERTS_ALC_A_EHEAP: save = &size.processes; break; @@ -2600,14 +2642,17 @@ erts_alloc_util_allocators(void *proc) /* * Currently all allocators except sys_alloc are * alloc_util allocators. + * Also hide test_alloc which is disabled by default + * and only intended for our own testing. */ - sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 1)*2; + sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 2)*2; ASSERT(sz > 0); hp = HAlloc((Process *) proc, sz); res = NIL; for (i = ERTS_ALC_A_MAX; i >= ERTS_ALC_A_MIN; i--) { switch (i) { case ERTS_ALC_A_SYSTEM: + case ERTS_ALC_A_TEST: break; default: { char *alc_str = (char *) ERTS_ALC_A2AD(i); @@ -3489,6 +3534,41 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) #else case 0xf13: return (UWord) 0; #endif + case 0xf14: return (UWord) erts_alloc(ERTS_ALC_T_TEST, (Uint)a1); + + case 0xf15: erts_free(ERTS_ALC_T_TEST, (void*)a1); return 0; + + case 0xf16: { + Uint extra_hdr_sz = UNIT_CEILING((Uint)a1); + ErtsAllocatorThrSpec_t* ts = &erts_allctr_thr_spec[ERTS_ALC_A_TEST]; + Uint offset = ts->allctr[0]->mbc_header_size; + void* orig_creating_mbc = ts->allctr[0]->creating_mbc; + void* orig_destroying_mbc = ts->allctr[0]->destroying_mbc; + void* new_creating_mbc = *(void**)a2; /* inout arg */ + void* new_destroying_mbc = *(void**)a3; /* inout arg */ + int i; + + for (i=0; i < ts->size; i++) { + Allctr_t* ap = ts->allctr[i]; + if (ap->mbc_header_size != offset + || ap->creating_mbc != orig_creating_mbc + || ap->destroying_mbc != orig_destroying_mbc + || ap->mbc_list.first != NULL) + return -1; + } + for (i=0; i < ts->size; i++) { + ts->allctr[i]->mbc_header_size += extra_hdr_sz; + ts->allctr[i]->creating_mbc = new_creating_mbc; + ts->allctr[i]->destroying_mbc = new_destroying_mbc; + } + *(void**)a2 = orig_creating_mbc; + *(void**)a3 = orig_destroying_mbc; + return offset; + } + case 0xf17: { + ErtsAllocatorThrSpec_t* ts = &erts_allctr_thr_spec[ERTS_ALC_A_TEST]; + return ts->allctr[0]->largest_mbc_size; + } default: break; } diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 75b4913012..e0bc71c88a 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -104,7 +104,7 @@ allocator LITERAL false literal_alloc allocator BINARY true binary_alloc allocator DRIVER true driver_alloc - +allocator TEST true test_alloc # --- Class declarations ----------------------------------------------------- # @@ -410,4 +410,7 @@ type CON_VPRINTF_BUF TEMPORARY SYSTEM con_vprintf_buf +endif +# This type should only be used for test +type TEST TEST SYSTEM testing + # ---------------------------------------------------------------------------- diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index f34916f1ab..eedfd1e13d 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -1632,6 +1632,16 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) static void dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, int superaligned); +static ERTS_INLINE void +dealloc_mbc(Allctr_t *allctr, Carrier_t *crr) +{ + ASSERT(IS_MB_CARRIER(crr)); + if (allctr->destroying_mbc) + allctr->destroying_mbc(allctr, crr); + + dealloc_carrier(allctr, crr, 1); +} + #ifdef ERTS_SMP static ERTS_INLINE Allctr_t* @@ -3344,7 +3354,7 @@ cpool_fetch(Allctr_t *allctr, UWord size) cpool_entrance = sentinel; cpdp = cpool_aint2cpd(cpool_read(&cpool_entrance->prev)); if (cpdp == sentinel) - return NULL; + goto check_dc_list; } has_passed_sentinel = 0; @@ -3355,18 +3365,18 @@ cpool_fetch(Allctr_t *allctr, UWord size) if (cpool_entrance == sentinel) { cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev)); if (cpdp == sentinel) - return NULL; + break; } i = 0; /* Last one to inspect */ } else if (cpdp == sentinel) { if (has_passed_sentinel) { /* We been here before. cpool_entrance must have been removed */ - return NULL; + break; } cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev)); if (cpdp == sentinel) - return NULL; + break; has_passed_sentinel = 1; } crr = (Carrier_t *)(((char *)cpdp) - offsetof(Carrier_t, cpool)); @@ -3390,10 +3400,12 @@ cpool_fetch(Allctr_t *allctr, UWord size) return NULL; } +check_dc_list: /* Last; check our own pending dealloc carrier list... */ crr = allctr->cpool.dc_list.last; while (crr) { if (erts_atomic_read_nob(&crr->cpool.max_size) >= size) { + Block_t* blk; unlink_carrier(&allctr->cpool.dc_list, crr); #ifdef ERTS_ALC_CPOOL_DEBUG ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_xchg_nob(&crr->allctr, @@ -3402,6 +3414,9 @@ cpool_fetch(Allctr_t *allctr, UWord size) #else erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr)); #endif + blk = MBC_TO_FIRST_BLK(allctr, crr); + ASSERT(FBLK_TO_MBC(blk) == crr); + allctr->link_free_block(allctr, blk); return crr; } crr = crr->prev; @@ -3432,7 +3447,7 @@ check_pending_dealloc_carrier(Allctr_t *allctr, dcrr = crr; crr = crr->next; - dealloc_carrier(allctr, dcrr, 1); + dealloc_mbc(allctr, dcrr); i++; } while (crr && i < ERTS_ALC_MAX_DEALLOC_CARRIER); @@ -3463,18 +3478,20 @@ static void schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr) { Allctr_t *orig_allctr; + Block_t *blk; int check_pending_dealloc; erts_aint_t max_size; + ASSERT(IS_MB_CARRIER(crr)); + if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { - dealloc_carrier(allctr, crr, 1); + dealloc_mbc(allctr, crr); return; } orig_allctr = crr->cpool.orig_allctr; if (allctr != orig_allctr) { - Block_t *blk = MBC_TO_FIRST_BLK(allctr, crr); int cinit = orig_allctr->dd.ix - allctr->dd.ix; /* @@ -3491,6 +3508,7 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr) * since the block is an mbc block that is free and last * in the carrier. */ + blk = MBC_TO_FIRST_BLK(allctr, crr); ERTS_ALC_CPOOL_ASSERT(IS_FREE_LAST_MBC_BLK(blk)); ERTS_ALC_CPOOL_ASSERT(IS_MBC_FIRST_ABLK(allctr, blk)); @@ -3510,11 +3528,13 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr) if (crr->cpool.thr_prgr == ERTS_THR_PRGR_INVALID || erts_thr_progress_has_reached(crr->cpool.thr_prgr)) { - dealloc_carrier(allctr, crr, 1); + dealloc_mbc(allctr, crr); return; } - max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr); + blk = MBC_TO_FIRST_BLK(allctr, crr); + ASSERT(IS_FREE_LAST_MBC_BLK(blk)); + max_size = (erts_aint_t) MBC_FBLK_SZ(blk); erts_atomic_set_nob(&crr->cpool.max_size, max_size); crr->next = NULL; @@ -4100,9 +4120,6 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) } #endif - if (allctr->destroying_mbc) - (*allctr->destroying_mbc)(allctr, crr); - #ifdef ERTS_SMP if (busy_pcrr_pp && *busy_pcrr_pp) { ERTS_ALC_CPOOL_ASSERT(*busy_pcrr_pp == crr); @@ -4126,12 +4143,15 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) else #endif STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz); + + if (allctr->remove_mbc) + allctr->remove_mbc(allctr, crr); } #ifdef ERTS_SMP schedule_dealloc_carrier(allctr, crr); #else - dealloc_carrier(allctr, crr, 1); + dealloc_mbc(allctr, crr); #endif } } @@ -6273,6 +6293,16 @@ erts_alcu_test(UWord op, UWord a1, UWord a2) case 0x023: return (UWord) 0; case 0x024: return (UWord) 0; #endif + case 0x025: /* UMEM2BLK_TEST*/ +#ifdef DEBUG +# ifdef HARD_DEBUG + return (UWord)UMEM2BLK(a1-3*sizeof(UWord)); +# else + return (UWord)UMEM2BLK(a1-2*sizeof(UWord)); +# endif +#else + return (UWord)UMEM2BLK(a1); +#endif default: ASSERT(0); return ~((UWord) 0); } diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 16ad673d26..b7d717ed23 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -313,7 +313,7 @@ typedef struct ErtsDoubleLink_t_ { typedef struct { erts_atomic_t next; erts_atomic_t prev; - Allctr_t *orig_allctr; + Allctr_t *orig_allctr; /* read-only while carrier is alive */ ErtsThrPrgrVal thr_prgr; erts_atomic_t max_size; UWord abandon_limit; diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index 7c2a5c3323..19420af8ab 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -209,7 +209,9 @@ static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint); static void aoff_link_free_block(Allctr_t *, Block_t*); static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del); static void aoff_creating_mbc(Allctr_t*, Carrier_t*); +#ifdef DEBUG static void aoff_destroying_mbc(Allctr_t*, Carrier_t*); +#endif static void aoff_add_mbc(Allctr_t*, Carrier_t*); static void aoff_remove_mbc(Allctr_t*, Carrier_t*); static UWord aoff_largest_fblk_in_mbc(Allctr_t*, Carrier_t*); @@ -271,7 +273,11 @@ erts_aoffalc_start(AOFFAllctr_t *alc, allctr->get_next_mbc_size = NULL; allctr->creating_mbc = aoff_creating_mbc; +#ifdef DEBUG allctr->destroying_mbc = aoff_destroying_mbc; +#else + allctr->destroying_mbc = NULL; +#endif allctr->add_mbc = aoff_add_mbc; allctr->remove_mbc = aoff_remove_mbc; allctr->largest_fblk_in_mbc = aoff_largest_fblk_in_mbc; @@ -885,17 +891,18 @@ static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier) HARD_CHECK_TREE(NULL, 0, *root, 0); } +#define IS_CRR_IN_TREE(CRR,ROOT) \ + ((CRR)->rbt_node.parent || (ROOT) == &(CRR)->rbt_node) + +#ifdef DEBUG static void aoff_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier) { AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; - AOFF_RBTree_t *root = alc->mbc_root; - if (crr->rbt_node.parent || &crr->rbt_node == root) { - aoff_remove_mbc(allctr, carrier); - } - /*else already removed */ + ASSERT(!IS_CRR_IN_TREE(crr, alc->mbc_root)); } +#endif static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier) { @@ -903,6 +910,7 @@ static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier) AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; AOFF_RBTree_t **root = &alc->mbc_root; + ASSERT(!IS_CRR_IN_TREE(crr, *root)); HARD_CHECK_TREE(NULL, 0, *root, 0); /* Link carrier in address order tree @@ -919,6 +927,10 @@ static void aoff_remove_mbc(Allctr_t *allctr, Carrier_t *carrier) AOFF_RBTree_t **root = &alc->mbc_root; ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(carrier)); + + if (!IS_CRR_IN_TREE(crr,*root)) + return; + HARD_CHECK_TREE(NULL, 0, *root, 0); rbt_delete(root, &crr->rbt_node); diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index b9640e211d..aec72bd61a 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -1614,6 +1614,10 @@ static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindStat Eterm *hp; Eterm ret; + if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL) + && binary_size(subject) == 0) { + return NIL; + } hp = HAlloc(p, 2); ret = CONS(hp, subject, NIL); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index bb75b8abb6..f952f937ce 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -130,6 +130,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef USE_SYSTEMTAP " [systemtap]" #endif +#ifdef SHCOPY + " [sharing-preserving]" +#endif "\n"); #define ASIZE(a) (sizeof(a)/sizeof(a[0])) diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 03f51132b1..4d67e39e7e 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1879,11 +1879,7 @@ new_seq_trace_token(Process* p) { Eterm* hp; - if (SEQ_TRACE_TOKEN(p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(p) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { hp = HAlloc(p, 6); SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0), /* Flags */ make_small(0), /* Label */ @@ -1903,12 +1899,8 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) BIF_ERROR(p, BADARG); } - if (SEQ_TRACE_TOKEN(p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(p) == am_have_dt_utag -#endif - ) { - if ((item == am_send) || (item == am_receive) || + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { + if ((item == am_send) || (item == am_receive) || (item == am_print) || (item == am_timestamp)) { hp = HAlloc(p,3); res = TUPLE2(hp, item, am_false); @@ -1964,11 +1956,7 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) */ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) { - if (SEQ_TRACE_TOKEN(BIF_P) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } seq_trace_update_send(BIF_P); @@ -1987,11 +1975,7 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) */ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) { - if (SEQ_TRACE_TOKEN(BIF_P) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag -#endif - ) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) { diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 9ec14ab5ae..3030c1c91a 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1832,7 +1832,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) tb->common.id, from_pid, BIF_ARG_3), - 0); + 0); erts_smp_proc_unlock(to_proc, to_locks); UnUseTmpHeap(5,BIF_P); BIF_RET(am_true); @@ -3211,7 +3211,7 @@ retry: tb->common.id, p->common.id, heir_data), - 0); + 0); erts_smp_proc_unlock(to_proc, to_locks); return !0; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 0bf9558ac9..399be6058c 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2308,11 +2308,7 @@ restart: *esp++ = am_true; break; case matchIsSeqTrace: - if (SEQ_TRACE_TOKEN(c_p) != NIL -#ifdef USE_VM_PROBES - && SEQ_TRACE_TOKEN(c_p) != am_have_dt_utag -#endif - ) + if (have_seqtrace(SEQ_TRACE_TOKEN(c_p))) *esp++ = am_true; else *esp++ = am_false; @@ -2336,11 +2332,7 @@ restart: --esp; break; case matchGetSeqToken: - if (SEQ_TRACE_TOKEN(c_p) == NIL -#ifdef USE_VM_PROBES - || SEQ_TRACE_TOKEN(c_p) == am_have_dt_utag -#endif - ) + if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p))) *esp++ = NIL; else { Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p); diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h index f4259e7dae..029320691d 100644 --- a/erts/emulator/beam/erl_debug.h +++ b/erts/emulator/beam/erl_debug.h @@ -48,6 +48,7 @@ #define DEBUG_THREADS 0x0010 /* Thread-related stuff */ #define DEBUG_PROCESSES 0x0020 /* Process creation and removal */ #define DEBUG_MEMORY 0x0040 /* Display results of memory checks */ +#define DEBUG_SHCOPY 0x0080 /* Sharing-preserving copying of terms */ extern Uint32 verbose; diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index e71b87803b..1093366e08 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -687,8 +687,8 @@ EXTERN int driver_dl_close(void *); EXTERN char *driver_dl_error(void); /* environment */ -EXTERN int erl_drv_putenv(char *key, char *value); -EXTERN int erl_drv_getenv(char *key, char *value, size_t *value_size); +EXTERN int erl_drv_putenv(const char *key, char *value); +EXTERN int erl_drv_getenv(const char *key, char *value, size_t *value_size); #endif /* !ERL_DRIVER_TYPES_ONLY */ diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index b63567e563..15226074c3 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -1193,6 +1193,9 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end, char* oh = (char *) OLD_HEAP(p); Uint oh_size = (char *) OLD_HTOP(p) - oh; + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); + n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*new_sz); @@ -1410,6 +1413,9 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end, Uint new_sz, stk_sz; int adjusted; + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id, + HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p))); + /* * Do a fullsweep GC. First figure out the size of the heap * to receive all live data. diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 628915eb23..99d8a2a987 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -1402,6 +1402,7 @@ erl_start(int argc, char **argv) case 't': verbose |= DEBUG_THREADS; break; case 'p': verbose |= DEBUG_PROCESSES; break; case 'm': verbose |= DEBUG_MESSAGES; break; + case 'c': verbose |= DEBUG_SHCOPY; break; default : erts_fprintf(stderr,"Unknown verbose option: %c\n",*ch); } } @@ -1414,6 +1415,7 @@ erl_start(int argc, char **argv) if (verbose & DEBUG_THREADS) erts_printf("THREADS "); if (verbose & DEBUG_PROCESSES) erts_printf("PROCESSES "); if (verbose & DEBUG_MESSAGES) erts_printf("MESSAGES "); + if (verbose & DEBUG_SHCOPY) erts_printf("SHCOPY "); erts_printf("\n"); #else erts_fprintf(stderr, "warning: -v (only in debug compiled code)\n"); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 797212450c..766e0bf52a 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -68,6 +68,7 @@ new_message_buffer(Uint size) bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(size)); ERTS_INIT_HEAP_FRAG(bp, size, size); + VERBOSE(DEBUG_SHCOPY, ("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem)); return bp; } @@ -249,36 +250,6 @@ erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_s } void -erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp) -{ - if (first_bp) { - ErlHeapFragment *bp = first_bp; - - while (1) { - /* Move any off_heap's into the process */ - if (bp->off_heap.first != NULL) { - struct erl_off_heap_header** next_p = &bp->off_heap.first; - while (*next_p != NULL) { - next_p = &((*next_p)->next); - } - *next_p = MSO(proc).first; - MSO(proc).first = bp->off_heap.first; - bp->off_heap.first = NULL; - OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); - } - MBUF_SIZE(proc) += bp->used_size; - if (!bp->next) - break; - bp = bp->next; - } - - /* Link the message buffer */ - bp->next = MBUF(proc); - MBUF(proc) = first_bp; - } -} - -void erts_queue_dist_message(Process *rcvr, ErtsProcLocks *rcvr_locks, ErtsDistExternal *dist_ext, @@ -343,7 +314,7 @@ erts_queue_dist_message(Process *rcvr, DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); dtrace_proc_str(rcvr, receiver_name); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -364,7 +335,7 @@ erts_queue_dist_message(Process *rcvr, DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); dtrace_proc_str(rcvr, receiver_name); - if (token != NIL && token != am_have_dt_utag) { + if (have_seqtrace(token)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(token)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token)); @@ -540,6 +511,36 @@ erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, ); } +void +erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp) +{ + if (first_bp) { + ErlHeapFragment *bp = first_bp; + + while (1) { + /* Move any off_heap's into the process */ + if (bp->off_heap.first != NULL) { + struct erl_off_heap_header** next_p = &bp->off_heap.first; + while (*next_p != NULL) { + next_p = &((*next_p)->next); + } + *next_p = MSO(proc).first; + MSO(proc).first = bp->off_heap.first; + bp->off_heap.first = NULL; + OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead); + } + MBUF_SIZE(proc) += bp->used_size; + if (!bp->next) + break; + bp = bp->next; + } + + /* Link the message buffer */ + bp->next = MBUF(proc); + MBUF(proc) = first_bp; + } +} + Uint erts_msg_attached_data_size_aux(ErtsMessage *msg) { @@ -678,11 +679,14 @@ erts_send_message(Process* sender, Eterm utag = NIL; #endif erts_aint32_t receiver_state; +#ifdef SHCOPY_SEND + erts_shcopy_t info; +#endif BM_STOP_TIMER(system); BM_MESSAGE(message,sender,receiver); BM_START_TIMER(send); - #ifdef USE_VM_PROBES +#ifdef USE_VM_PROBES *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send)) { erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), @@ -701,48 +705,61 @@ erts_send_message(Process* sender, #ifdef USE_VM_PROBES Uint dt_utag_size = 0; #endif - - BM_SWAP_TIMER(send,size); - msize = size_object(message); - BM_SWAP_TIMER(size,send); - -#ifdef USE_VM_PROBES - if (stoken != am_have_dt_utag) { -#endif - + BM_SWAP_TIMER(send,size); + + /* SHCOPY corrupts the heap between + * copy_shared_calculate, and + * copy_shared_perform. (it inserts move_markers like the gc). + * Make sure we don't use the heap between those instances. + */ + if (have_seqtrace(stoken)) { seq_trace_update_send(sender); seq_trace_output(stoken, message, SEQ_TRACE_SEND, receiver->common.id, sender); seq_trace_size = 6; /* TUPLE5 */ -#ifdef USE_VM_PROBES - } - if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { - dt_utag_size = size_object(DT_UTAG(sender)); - } else if (stoken == am_have_dt_utag ) { - stoken = NIL; } +#ifdef USE_VM_PROBES + if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { + dt_utag_size = size_object(DT_UTAG(sender)); + } else if (stoken == am_have_dt_utag ) { + stoken = NIL; + } #endif - mp = erts_alloc_message_heap_state(receiver, - &receiver_state, - receiver_locks, - (msize +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info); +#else + msize = size_object(message); +#endif + BM_SWAP_TIMER(size,send); + + mp = erts_alloc_message_heap_state(receiver, + &receiver_state, + receiver_locks, + (msize #ifdef USE_VM_PROBES - + dt_utag_size + + dt_utag_size #endif - + seq_trace_size), - &hp, - &ohp); + + seq_trace_size), + &hp, + &ohp); BM_SWAP_TIMER(send,copy); + +#ifdef SHCOPY_SEND + if (is_not_immed(message)) + message = copy_shared_perform(message, msize, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); +#endif if (is_immed(stoken)) token = stoken; else token = copy_struct(stoken, seq_trace_size, &hp, ohp); - if (is_not_immed(message)) - message = copy_struct(message, msize, &hp, ohp); - #ifdef USE_VM_PROBES if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) { if (is_immed(DT_UTAG(sender))) @@ -761,7 +778,7 @@ erts_send_message(Process* sender, #ifdef USE_VM_PROBES if (DTRACE_ENABLED(message_send)) { - if (stoken != NIL && stoken != am_have_dt_utag) { + if (have_seqtrace(stoken)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken)); tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken)); tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken)); @@ -779,7 +796,12 @@ erts_send_message(Process* sender, } else { BM_SWAP_TIMER(send,size); - msize = size_object(message); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + msize = copy_shared_calculate(message, &info); +#else + msize = size_object(message); +#endif BM_SWAP_TIMER(size,send); mp = erts_alloc_message_heap_state(receiver, @@ -789,8 +811,14 @@ erts_send_message(Process* sender, &hp, &ohp); BM_SWAP_TIMER(send,copy); - if (is_not_immed(message)) - message = copy_struct(message, msize, &hp, ohp); +#ifdef SHCOPY_SEND + if (is_not_immed(message)) + message = copy_shared_perform(message, msize, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + if (is_not_immed(message)) + message = copy_struct(message, msize, &hp, ohp); +#endif BM_MESSAGE_COPIED(msz); BM_SWAP_TIMER(copy,send); } @@ -815,6 +843,7 @@ erts_send_message(Process* sender, return res; } + /* * This function delivers an EXIT message to a process * which is trapping EXITs. @@ -834,21 +863,29 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, Eterm temptoken; ErtsMessage* mp; ErlOffHeap *ohp; - - if (token != NIL -#ifdef USE_VM_PROBES - && token != am_have_dt_utag +#ifdef SHCOPY_SEND + erts_shcopy_t info; #endif - ) { + if (have_seqtrace(token)) { ASSERT(is_tuple(token)); - sz_reason = size_object(reason); sz_token = size_object(token); sz_from = size_object(from); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + sz_reason = copy_shared_calculate(reason, &info); +#else + sz_reason = size_object(reason); +#endif mp = erts_alloc_message_heap(to, to_locksp, sz_reason + sz_from + sz_token + 4, &hp, &ohp); +#ifdef SHCOPY_SEND + mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else mess = copy_struct(reason, sz_reason, &hp, ohp); +#endif from_copy = copy_struct(from, sz_from, &hp, ohp); save = TUPLE3(hp, am_EXIT, from_copy, mess); hp += 4; @@ -857,13 +894,22 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, temptoken = copy_struct(token, sz_token, &hp, ohp); erts_queue_message(to, to_locksp, mp, save, temptoken); } else { - sz_reason = size_object(reason); sz_from = IS_CONST(from) ? 0 : size_object(from); - +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + sz_reason = copy_shared_calculate(reason, &info); +#else + sz_reason = size_object(reason); +#endif mp = erts_alloc_message_heap(to, to_locksp, sz_reason+sz_from+4, &hp, &ohp); +#ifdef SHCOPY_SEND + mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else mess = copy_struct(reason, sz_reason, &hp, ohp); +#endif from_copy = (IS_CONST(from) ? from : copy_struct(from, sz_from, &hp, ohp)); @@ -1801,4 +1847,3 @@ void erts_factory_undo(ErtsHeapFactory* factory) factory->heap_frags = NULL; #endif } - diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index e241926638..fa9bb2ecde 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -128,6 +128,13 @@ struct erl_heap_fragment { #else #endif +#ifdef USE_VM_PROBES +#define have_no_seqtrace(T) ((T) == NIL || (T) == am_have_dt_utag) +#else +#define have_no_seqtrace(T) ((T) == NIL) +#endif +#define have_seqtrace(T) (!have_no_seqtrace(T)) + #define ERL_MESSAGE_REF_FIELDS__ \ ErtsMessage *next; /* Next message */ \ union { \ diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index a37cda93ef..d659788f30 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -379,9 +379,19 @@ ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term) { Uint sz; Eterm* hp; +#ifdef SHCOPY + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); + sz = copy_shared_calculate(src_term, &info); + hp = alloc_heap(dst_env, sz); + src_term = copy_shared_perform(src_term, sz, &info, &hp, &MSO(dst_env->proc)); + DESTROY_SHCOPY(info); + return src_term; +#else sz = size_object(src_term); hp = alloc_heap(dst_env, sz); return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc)); +#endif } @@ -1176,6 +1186,7 @@ ErlNifTid enif_thread_self(void) { return erl_drv_thread_self(); } int enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2) { return erl_drv_equal_tids(tid1,tid2); } void enif_thread_exit(void *resp) { erl_drv_thread_exit(resp); } int enif_thread_join(ErlNifTid tid, void **respp) { return erl_drv_thread_join(tid,respp); } +int enif_getenv(const char *key, char *value, size_t *value_size) { return erl_drv_getenv(key, value, value_size); } int enif_fprintf(void* filep, const char* format, ...) { diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 5da6bb877a..1a21048ec9 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -48,9 +48,10 @@ ** add ErlNifEntry options ** add ErlNifFunc flags ** 2.8: 18.0 add enif_has_pending_exception +** 2.9: 18.2 enif_getenv */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 8 +#define ERL_NIF_MINOR_VERSION 9 /* * The emulator will refuse to load a nif-lib with a major version @@ -222,6 +223,7 @@ typedef enum { # define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS typedef struct { # include "erl_nif_api_funcs.h" + void* erts_alc_test; } TWinDynNifCallbacks; extern TWinDynNifCallbacks WinDynNifCallbacks; # undef ERL_NIF_API_FUNC_DECL diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 2f2180e1aa..08b9afc6af 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -159,6 +159,7 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env, ERL_NIF_TERM* reason)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_raise_exception, (ErlNifEnv *env, ERL_NIF_TERM reason)); +ERL_NIF_API_FUNC_DECL(int,enif_getenv,(const char* key, char* value, size_t* value_size)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -310,6 +311,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_schedule_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_nif) # define enif_has_pending_exception ERL_NIF_API_FUNC_MACRO(enif_has_pending_exception) # define enif_raise_exception ERL_NIF_API_FUNC_MACRO(enif_raise_exception) +# define enif_getenv ERL_NIF_API_FUNC_MACRO(enif_getenv) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index a4da288e79..74e3e81d6f 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -37,18 +37,18 @@ erts_smp_rwmtx_t erts_node_table_rwmtx; DistEntry *erts_hidden_dist_entries; DistEntry *erts_visible_dist_entries; -DistEntry *erts_not_connected_dist_entries; +DistEntry *erts_not_connected_dist_entries; /* including erts_this_dist_entry */ Sint erts_no_of_hidden_dist_entries; Sint erts_no_of_visible_dist_entries; -Sint erts_no_of_not_connected_dist_entries; +Sint erts_no_of_not_connected_dist_entries; /* including erts_this_dist_entry */ DistEntry *erts_this_dist_entry; ErlNode *erts_this_node; char erts_this_node_sysname_BUFFER[256], *erts_this_node_sysname = "uninitialized yet"; -static Uint node_entries; -static Uint dist_entries; +static Uint node_entries = 0; +static Uint dist_entries = 0; static int references_atoms_need_init = 1; @@ -91,9 +91,6 @@ dist_table_alloc(void *dep_tmpl) erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; - if(((DistEntry *) dep_tmpl) == erts_this_dist_entry) - return dep_tmpl; - sysname = ((DistEntry *) dep_tmpl)->sysname; chnl_nr = make_small((Uint) atom_val(sysname)); dep = (DistEntry *) erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry)); @@ -132,7 +129,9 @@ dist_table_alloc(void *dep_tmpl) /* Link in */ - /* All new dist entries are "not connected" */ + /* All new dist entries are "not connected". + * erts_this_dist_entry is also always included among "not connected" + */ dep->next = erts_not_connected_dist_entries; if(erts_not_connected_dist_entries) { ASSERT(erts_not_connected_dist_entries->prev == NULL); @@ -149,9 +148,6 @@ dist_table_free(void *vdep) { DistEntry *dep = (DistEntry *) vdep; - if(dep == erts_this_dist_entry) - return; - ASSERT(is_nil(dep->cid)); ASSERT(dep->nlinks == NULL); ASSERT(dep->node_links == NULL); @@ -186,7 +182,7 @@ dist_table_free(void *vdep) #endif erts_free(ERTS_ALC_T_DIST_ENTRY, (void *) dep); - ASSERT(dist_entries > 1); + ASSERT(dist_entries > 0); dist_entries--; } @@ -306,7 +302,7 @@ static void try_delete_dist_entry(void *vdep) * thread incremented refc twice. Once for the new reference * and once for this thread. * - * If refc reach -1, noone has used the entry since we + * If refc reach -1, no one has used the entry since we * set up the timer. Delete the entry. * * If refc reach 0, the entry is currently not in use @@ -369,8 +365,7 @@ erts_dist_table_size(void) ASSERT(dist_entries == (erts_no_of_visible_dist_entries + erts_no_of_hidden_dist_entries - + erts_no_of_not_connected_dist_entries - + 1 /* erts_this_dist_entry */)); + + erts_no_of_not_connected_dist_entries)); #endif res = (hash_table_sz(&erts_dist_table) @@ -543,9 +538,6 @@ node_table_alloc(void *venp_tmpl) { ErlNode *enp; - if(((ErlNode *) venp_tmpl) == erts_this_node) - return venp_tmpl; - enp = (ErlNode *) erts_alloc(ERTS_ALC_T_NODE_ENTRY, sizeof(ErlNode)); node_entries++; @@ -563,8 +555,7 @@ node_table_free(void *venp) { ErlNode *enp = (ErlNode *) venp; - if(enp == erts_this_node) - return; + ERTS_SMP_LC_ASSERT(enp != erts_this_node || erts_thr_progress_is_blocking()); erts_deref_dist_entry(enp->dist_entry); #ifdef DEBUG @@ -572,7 +563,7 @@ node_table_free(void *venp) #endif erts_free(ERTS_ALC_T_NODE_ENTRY, venp); - ASSERT(node_entries > 1); + ASSERT(node_entries > 0); node_entries--; } @@ -650,7 +641,7 @@ static void try_delete_node(void *venp) * thread incremented refc twice. Once for the new reference * and once for this thread. * - * If refc reach -1, noone has used the entry since we + * If refc reach -1, no one has used the entry since we * set up the timer. Delete the entry. * * If refc reach 0, the entry is currently not in use @@ -747,25 +738,20 @@ void erts_print_node_info(int to, void erts_set_this_node(Eterm sysname, Uint creation) { - erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); - erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking()); + ASSERT(erts_refc_read(&erts_this_dist_entry->refc, 2)); - (void) hash_erase(&erts_dist_table, (void *) erts_this_dist_entry); - erts_this_dist_entry->sysname = sysname; - erts_this_dist_entry->creation = creation; - (void) hash_put(&erts_dist_table, (void *) erts_this_dist_entry); + if (erts_refc_dectest(&erts_this_node->refc, 0) == 0) + try_delete_node(erts_this_node); - (void) hash_erase(&erts_node_table, (void *) erts_this_node); - erts_this_node->sysname = sysname; - erts_this_node->creation = creation; - erts_this_node_sysname = erts_this_node_sysname_BUFFER; - erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), - "%T", sysname); - (void) hash_put(&erts_node_table, (void *) erts_this_node); + if (erts_refc_dectest(&erts_this_dist_entry->refc, 0) == 0) + try_delete_dist_entry(erts_this_dist_entry); - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); - erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + erts_this_node = NULL; /* to make sure refc is bumped for this node */ + erts_this_node = erts_find_or_insert_node(sysname, creation); + erts_this_dist_entry = erts_this_node->dist_entry; + erts_refc_inc(&erts_this_dist_entry->refc, 2); } Uint @@ -782,6 +768,7 @@ void erts_init_node_tables(int dd_sec) { erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; HashFunctions f; + ErlNode node_tmpl; if (dd_sec == ERTS_NODE_TAB_DELAY_GC_INFINITY) node_tab_delete_delay = (ErtsMonotonicTime) -1; @@ -793,16 +780,21 @@ void erts_init_node_tables(int dd_sec) rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED; + erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table"); + erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table"); + f.hash = (H_FUN) dist_table_hash; f.cmp = (HCMP_FUN) dist_table_cmp; f.alloc = (HALLOC_FUN) dist_table_alloc; f.free = (HFREE_FUN) dist_table_free; - - erts_this_dist_entry = erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry)); - dist_entries = 1; - hash_init(ERTS_ALC_T_DIST_TABLE, &erts_dist_table, "dist_table", 11, f); + f.hash = (H_FUN) node_table_hash; + f.cmp = (HCMP_FUN) node_table_cmp; + f.alloc = (HALLOC_FUN) node_table_alloc; + f.free = (HFREE_FUN) node_table_free; + hash_init(ERTS_ALC_T_NODE_TABLE, &erts_node_table, "node_table", 11, f); + erts_hidden_dist_entries = NULL; erts_visible_dist_entries = NULL; erts_not_connected_dist_entries = NULL; @@ -810,69 +802,23 @@ void erts_init_node_tables(int dd_sec) erts_no_of_visible_dist_entries = 0; erts_no_of_not_connected_dist_entries = 0; - erts_this_dist_entry->next = NULL; - erts_this_dist_entry->prev = NULL; - erts_refc_init(&erts_this_dist_entry->refc, 1); /* erts_this_node */ - - erts_smp_rwmtx_init_opt_x(&erts_this_dist_entry->rwmtx, - &rwmtx_opt, - "dist_entry", - make_small(ERST_INTERNAL_CHANNEL_NO)); - erts_this_dist_entry->sysname = am_Noname; - erts_this_dist_entry->cid = NIL; - erts_this_dist_entry->connection_id = 0; - erts_this_dist_entry->status = 0; - erts_this_dist_entry->flags = 0; - erts_this_dist_entry->version = 0; - - erts_smp_mtx_init_x(&erts_this_dist_entry->lnk_mtx, - "dist_entry_links", - make_small(ERST_INTERNAL_CHANNEL_NO)); - erts_this_dist_entry->node_links = NULL; - erts_this_dist_entry->nlinks = NULL; - erts_this_dist_entry->monitors = NULL; - - erts_smp_mtx_init_x(&erts_this_dist_entry->qlock, - "dist_entry_out_queue", - make_small(ERST_INTERNAL_CHANNEL_NO)); - erts_this_dist_entry->qflgs = 0; - erts_this_dist_entry->qsize = 0; - erts_this_dist_entry->out_queue.first = NULL; - erts_this_dist_entry->out_queue.last = NULL; - erts_this_dist_entry->suspended = NULL; - - erts_this_dist_entry->finalized_out_queue.first = NULL; - erts_this_dist_entry->finalized_out_queue.last = NULL; - erts_smp_atomic_init_nob(&erts_this_dist_entry->dist_cmd_scheduled, 0); - erts_port_task_handle_init(&erts_this_dist_entry->dist_cmd); - erts_this_dist_entry->send = NULL; - erts_this_dist_entry->cache = NULL; - - (void) hash_put(&erts_dist_table, (void *) erts_this_dist_entry); - - f.hash = (H_FUN) node_table_hash; - f.cmp = (HCMP_FUN) node_table_cmp; - f.alloc = (HALLOC_FUN) node_table_alloc; - f.free = (HFREE_FUN) node_table_free; + node_tmpl.sysname = am_Noname; + node_tmpl.creation = 0; + erts_this_node = hash_put(&erts_node_table, &node_tmpl); + /* +1 for erts_this_node */ + erts_refc_init(&erts_this_node->refc, 1); - hash_init(ERTS_ALC_T_NODE_TABLE, &erts_node_table, "node_table", 11, f); + ASSERT(erts_this_node->dist_entry != NULL); + erts_this_dist_entry = erts_this_node->dist_entry; + /* +1 for erts_this_dist_entry */ + /* +1 for erts_this_node->dist_entry */ + erts_refc_init(&erts_this_dist_entry->refc, 2); - erts_this_node = erts_alloc(ERTS_ALC_T_NODE_ENTRY, sizeof(ErlNode)); - node_entries = 1; - erts_refc_init(&erts_this_node->refc, 1); /* The system itself */ - erts_this_node->sysname = am_Noname; - erts_this_node->creation = 0; - erts_this_node->dist_entry = erts_this_dist_entry; erts_this_node_sysname = erts_this_node_sysname_BUFFER; erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER), "%T", erts_this_node->sysname); - (void) hash_put(&erts_node_table, (void *) erts_this_node); - - erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table"); - erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table"); - references_atoms_need_init = 1; } @@ -1394,6 +1340,10 @@ setup_reference_table(void) SYSTEM_REF, TUPLE2(&heap[0], AM_system, am_undefined)); + insert_dist_entry(erts_this_dist_entry, + SYSTEM_REF, + TUPLE2(&heap[0], AM_system, am_undefined), + erts_this_node->creation); UnUseTmpHeapNoproc(3); max = erts_ptab_max(&erts_proc); @@ -1450,12 +1400,6 @@ setup_reference_table(void) insert_links(ERTS_P_LINKS(proc), proc->common.id); if (ERTS_P_MONITORS(proc)) insert_monitors(ERTS_P_MONITORS(proc), proc->common.id); - /* Insert controller */ - { - DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc); - if (dep) - insert_dist_entry(dep, CTRL_REF, proc->common.id, 0); - } } } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 7a31aa3e33..6c132a7e3d 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -617,11 +617,6 @@ erts_pre_init_process(void) erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks = ERTS_PSD_SCHED_ID_SET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].get_locks - = ERTS_PSD_DIST_ENTRY_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks - = ERTS_PSD_DIST_ENTRY_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 @@ -10747,6 +10742,10 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm res = THE_NON_VALUE; erts_aint32_t state = 0; erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL; +#ifdef SHCOPY_SPAWN + erts_shcopy_t info; + INITIALIZE_SHCOPY(info); +#endif #ifdef ERTS_SMP erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR); @@ -10802,7 +10801,11 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_COUNT(processes_spawned); BM_SWAP_TIMER(system,size); +#ifdef SHCOPY_SPAWN + arg_size = copy_shared_calculate(args, &info); +#else arg_size = size_object(args); +#endif BM_SWAP_TIMER(size,system); heap_need = arg_size; @@ -10880,7 +10883,12 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). BM_MESSAGE(args,p,parent); BM_START_TIMER(system); BM_SWAP_TIMER(system,copy); +#ifdef SHCOPY_SPAWN + p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap); + DESTROY_SHCOPY(info); +#else p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap); +#endif BM_MESSAGE_COPIED(arg_size); BM_SWAP_TIMER(copy,system); p->arity = 3; @@ -11265,6 +11273,8 @@ delete_process(Process* p) { Eterm *heap; 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 */ @@ -11514,31 +11524,40 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, { ErtsMessage *mp; ErlOffHeap *ohp; - - if (token == NIL -#ifdef USE_VM_PROBES - || token == am_have_dt_utag -#endif - ) { - Eterm* hp; - Eterm mess; - - mp = erts_alloc_message_heap(to, to_locksp, - term_size, &hp, &ohp); + Eterm* hp; + Eterm mess; +#ifdef SHCOPY_SEND + erts_shcopy_t info; +#endif + + if (!have_seqtrace(token)) { +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + term_size = copy_shared_calculate(exit_term, &info); + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); + mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); +#endif erts_queue_message(to, to_locksp, mp, mess, NIL); } else { - Eterm* hp; - Eterm mess; Eterm temp_token; Uint sz_token; ASSERT(is_tuple(token)); sz_token = size_object(token); - - mp = erts_alloc_message_heap(to, to_locksp, - term_size+sz_token, &hp, &ohp); +#ifdef SHCOPY_SEND + INITIALIZE_SHCOPY(info); + term_size = copy_shared_calculate(exit_term, &info); + mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp); + mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp); + DESTROY_SHCOPY(info); +#else + mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); +#endif /* the trace token must in this case be updated by the caller */ seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL); temp_token = copy_struct(token, sz_token, &hp, ohp); @@ -11651,11 +11670,7 @@ send_exit_signal(Process *c_p, /* current process if and only if ((state & ERTS_PSFLG_TRAP_EXIT) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { - if (is_not_nil(token) -#ifdef USE_VM_PROBES - && token != am_have_dt_utag -#endif - && token_update) + if (have_seqtrace(token) && token_update) seq_trace_update_send(token_update); if (is_value(exit_tuple)) send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token); @@ -12318,9 +12333,7 @@ erts_continue_exit_process(Process *p) erts_proc_dec_refc(p); } - dep = ((p->flags & F_DISTRIBUTION) - ? ERTS_PROC_SET_DIST_ENTRY(p, ERTS_PROC_LOCKS_ALL, NULL) - : NULL); + 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); @@ -12332,8 +12345,6 @@ erts_continue_exit_process(Process *p) if (dep) { erts_do_net_exits(dep, reason); - if(dep) - erts_deref_dist_entry(dep); } /* diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index f0798d8c2d..71065d875a 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -788,12 +788,11 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_ERROR_HANDLER 0 #define ERTS_PSD_SAVED_CALLS_BUF 1 #define ERTS_PSD_SCHED_ID 2 -#define ERTS_PSD_DIST_ENTRY 3 -#define ERTS_PSD_CALL_TIME_BP 4 -#define ERTS_PSD_DELAYED_GC_TASK_QS 5 -#define ERTS_PSD_NIF_TRAP_EXPORT 6 +#define ERTS_PSD_CALL_TIME_BP 3 +#define ERTS_PSD_DELAYED_GC_TASK_QS 4 +#define ERTS_PSD_NIF_TRAP_EXPORT 5 -#define ERTS_PSD_SIZE 7 +#define ERTS_PSD_SIZE 6 typedef struct { void *data[ERTS_PSD_SIZE]; @@ -811,9 +810,6 @@ typedef struct { #define ERTS_PSD_SCHED_ID_GET_LOCKS ERTS_PROC_LOCK_STATUS #define ERTS_PSD_SCHED_ID_SET_LOCKS ERTS_PROC_LOCK_STATUS -#define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN - #define ERTS_PSD_CALL_TIME_BP_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_CALL_TIME_BP_SET_LOCKS ERTS_PROC_LOCK_MAIN @@ -1899,11 +1895,6 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) #define ERTS_PROC_SCHED_ID(P, L, ID) \ ((UWord) erts_psd_set((P), (L), ERTS_PSD_SCHED_ID, (void *) (ID))) -#define ERTS_PROC_GET_DIST_ENTRY(P) \ - ((DistEntry *) erts_psd_get((P), ERTS_PSD_DIST_ENTRY)) -#define ERTS_PROC_SET_DIST_ENTRY(P, L, D) \ - ((DistEntry *) erts_psd_set((P), (L), ERTS_PSD_DIST_ENTRY, (void *) (D))) - #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) \ diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index d02f1f7213..b774ba97af 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1046,11 +1046,7 @@ seq_trace_update_send(Process *p) { Eterm seq_tracer = erts_get_system_seq_tracer(); ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); - if ( (p->common.id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL) -#ifdef USE_VM_PROBES - || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag) -#endif - ) { + if ((p->common.id == seq_tracer) || have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { return 0; } SEQ_TRACE_TOKEN_SENDER(p) = p->common.id; diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index c3e93d1ad2..58010dcb72 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1179,7 +1179,7 @@ typedef struct { ErtsHeapFactory factory; int remaining_n; char* remaining_bytes; - Eterm* maps_list; + ErtsWStack flat_maps; ErtsPStack hamt_array; } B2TDecodeContext; @@ -1519,7 +1519,7 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar ctx->u.dc.res = (Eterm) (UWord) NULL; ctx->u.dc.next = &ctx->u.dc.res; erts_factory_proc_prealloc_init(&ctx->u.dc.factory, p, ctx->heap_size); - ctx->u.dc.maps_list = NULL; + ctx->u.dc.flat_maps.wstart = NULL; ctx->u.dc.hamt_array.pstart = NULL; ctx->state = B2TDecode; /*fall through*/ @@ -2919,7 +2919,7 @@ dec_term(ErtsDistExternal *edep, int n; ErtsAtomEncoding char_enc; register Eterm* hp; /* Please don't take the address of hp */ - Eterm *maps_list; /* for preprocessing of small maps */ + DECLARE_WSTACK(flat_maps); /* for preprocessing of small maps */ Eterm* next; SWord reds; #ifdef DEBUG @@ -2931,7 +2931,6 @@ dec_term(ErtsDistExternal *edep, next = ctx->u.dc.next; ep = ctx->u.dc.ep; factory = &ctx->u.dc.factory; - maps_list = ctx->u.dc.maps_list; if (ctx->state != B2TDecode) { int n_limit = reds; @@ -3007,15 +3006,18 @@ dec_term(ErtsDistExternal *edep, } } PSTACK_CHANGE_ALLOCATOR(hamt_array, ERTS_ALC_T_SAVED_ESTACK); + WSTACK_CHANGE_ALLOCATOR(flat_maps, ERTS_ALC_T_SAVED_ESTACK); if (ctx->u.dc.hamt_array.pstart) { PSTACK_RESTORE(hamt_array, &ctx->u.dc.hamt_array); } + if (ctx->u.dc.flat_maps.wstart) { + WSTACK_RESTORE(flat_maps, &ctx->u.dc.flat_maps); + } } else { reds = ERTS_SWORD_MAX; next = objp; *next = (Eterm) (UWord) NULL; - maps_list = NULL; } hp = factory->hp; @@ -3571,14 +3573,8 @@ dec_term_atom_common: * vptr, last word for values */ - /* - * Use thing_word to link through decoded maps. - * The list of maps is for later validation. - */ - - mp->thing_word = (Eterm) maps_list; - maps_list = (Eterm *) mp; - + WSTACK_PUSH(flat_maps, (UWord)mp); + mp->thing_word = MAP_HEADER_FLATMAP; mp->size = size; mp->keys = keys; *objp = make_flatmap(mp); @@ -3827,7 +3823,9 @@ dec_term_atom_common: ctx->u.dc.ep = ep; ctx->u.dc.next = next; ctx->u.dc.factory.hp = hp; - ctx->u.dc.maps_list = maps_list; + if (!WSTACK_ISEMPTY(flat_maps)) { + WSTACK_SAVE(flat_maps, &ctx->u.dc.flat_maps); + } if (!PSTACK_IS_EMPTY(hamt_array)) { PSTACK_SAVE(hamt_array, &ctx->u.dc.hamt_array); } @@ -3841,18 +3839,6 @@ dec_term_atom_common: } } - /* Iterate through all the maps and check for validity and sort keys - * - done here for when we know it is complete. - */ - - while (maps_list) { - next = (Eterm *) *maps_list; - *maps_list = MAP_HEADER_FLATMAP; - if (!erts_validate_and_sort_flatmap((flatmap_t*)maps_list)) - goto error; - maps_list = next; - } - ASSERT(hp <= factory->hp_end || (factory->mode == FACTORY_CLOSED && is_immed(*dbg_resultp))); factory->hp = hp; @@ -3861,20 +3847,31 @@ dec_term_atom_common: */ if (!PSTACK_IS_EMPTY(hamt_array)) { - do { - struct dec_term_hamt* hamt = PSTACK_TOP(hamt_array); - - *hamt->objp = erts_hashmap_from_array(factory, - hamt->leaf_array, - hamt->size, - 1); - if (is_non_value(*hamt->objp)) - goto error_hamt; - - (void) PSTACK_POP(hamt_array); - } while (!PSTACK_IS_EMPTY(hamt_array)); - PSTACK_DESTROY(hamt_array); + do { + struct dec_term_hamt* hamt = PSTACK_TOP(hamt_array); + + *hamt->objp = erts_hashmap_from_array(factory, + hamt->leaf_array, + hamt->size, + 1); + if (is_non_value(*hamt->objp)) + goto error_hamt; + + (void) PSTACK_POP(hamt_array); + } while (!PSTACK_IS_EMPTY(hamt_array)); + PSTACK_DESTROY(hamt_array); + } + + /* Iterate through all the (flat)maps and check for validity and sort keys + * - done here for when we know it is complete. + */ + + while(!WSTACK_ISEMPTY(flat_maps)) { + next = (Eterm *)WSTACK_POP(flat_maps); + if (!erts_validate_and_sort_flatmap((flatmap_t*)next)) + goto error; } + WSTACK_DESTROY(flat_maps); ASSERT((Eterm*)*dbg_resultp != NULL); @@ -3900,6 +3897,7 @@ error_hamt: ctx->state = B2TDecodeFail; ctx->reds = reds; } + WSTACK_DESTROY(flat_maps); return NULL; } diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 594c0ccf94..98c275a20c 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -380,7 +380,7 @@ extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */ extern int stackdump_on_exit; /* - * Here is an implementation of a lightweiht stack. + * Here is an implementation of a lightweight stack. * * Use it like this: * @@ -845,6 +845,94 @@ do {\ } while(0) +/* + * An implementation of lightweight unbounded queues, + * using a circular dynamic array. + * It does not include support for change_allocator. + * + * Use it like this: + * + * DECLARE_EQUEUE(Queue) (At the start of a block) + * ... + * EQUEUE_PUT(Queue, Term) + * ... + * if (EQUEUE_ISEMPTY(Queue)) { + * Queue is empty + * } else { + * Term = EQUEUE_GET(Stack); + * Process popped Term here + * } + * ... + * DESTROY_EQUEUE(Queue) + */ + +typedef struct { + Eterm* start; + Eterm* front; + Eterm* back; + int possibly_empty; + Eterm* end; + ErtsAlcType_t alloc_type; +} ErtsEQueue; + +#define DEF_EQUEUE_SIZE (16) + +void erl_grow_equeue(ErtsEQueue*, Eterm* def_queue); +#define EQUE_CONCAT(a,b) a##b +#define EQUE_DEF_QUEUE(q) EQUE_CONCAT(q,_default_equeue) + +#define DECLARE_EQUEUE(q) \ + UWord EQUE_DEF_QUEUE(q)[DEF_EQUEUE_SIZE]; \ + ErtsEQueue q = { \ + EQUE_DEF_QUEUE(q), /* start */ \ + EQUE_DEF_QUEUE(q), /* front */ \ + EQUE_DEF_QUEUE(q), /* back */ \ + 1, /* possibly_empty */ \ + EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \ + ERTS_ALC_T_ESTACK /* alloc_type */ \ + } + +#define DESTROY_EQUEUE(q) \ +do { \ + if (q.start != EQUE_DEF_QUEUE(q)) { \ + erts_free(q.alloc_type, q.start); \ + } \ +} while(0) + +#define EQUEUE_PUT_UNCHECKED(q, x) \ +do { \ + q.possibly_empty = 0; \ + *(q.back) = (x); \ + if (++(q.back) == q.end) { \ + q.back = q.start; \ + } \ +} while(0) + +#define EQUEUE_PUT(q, x) \ +do { \ + if (q.back == q.front && !q.possibly_empty) { \ + erl_grow_equeue(&q, EQUE_DEF_QUEUE(q)); \ + } \ + EQUEUE_PUT_UNCHECKED(q, x); \ +} while(0) + +#define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty) + +ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q) { + Eterm x; + q->possibly_empty = 1; + x = *(q->front); + if (++(q->front) == q->end) { + q->front = q->start; + } + return x; +} +#endif +#define EQUEUE_GET(q) erts_equeue_get(&(q)); + /* binary.c */ void erts_emasculate_writable_binary(ProcBin* pb); @@ -899,6 +987,12 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* beam_bif_load.c */ Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp); +typedef struct { + Eterm *ptr; + Uint sz; +} copy_literals_t; + +extern copy_literals_t erts_clrange; /* beam_load.c */ typedef struct { @@ -953,12 +1047,67 @@ __decl_noreturn void __noreturn erl_exit(int n, char*, ...); __decl_noreturn void __noreturn erl_exit_flush_async(int n, char*, ...); void erl_error(char*, va_list); +/* This controls whether sharing-preserving copy is used by Erlang */ + +#ifdef SHCOPY +#define SHCOPY_SEND +#define SHCOPY_SPAWN +#endif + +/* The persistent state while the sharing-preserving copier works */ + +typedef struct { + Eterm queue_default[DEF_EQUEUE_SIZE]; + Eterm* queue_start; + Eterm* queue_end; + ErtsAlcType_t queue_alloc_type; + UWord bitstore_default[DEF_WSTACK_SIZE]; + UWord* bitstore_start; + ErtsAlcType_t bitstore_alloc_type; + Eterm shtable_default[DEF_ESTACK_SIZE]; + Eterm* shtable_start; + ErtsAlcType_t shtable_alloc_type; + Uint literal_size; + Eterm *range_ptr; + Uint range_sz; +} erts_shcopy_t; + +#define INITIALIZE_SHCOPY(info) \ +do { \ + info.queue_start = info.queue_default; \ + info.bitstore_start = info.bitstore_default; \ + info.shtable_start = info.shtable_default; \ + info.literal_size = 0; \ + info.range_ptr = erts_clrange.ptr; \ + info.range_sz = erts_clrange.sz; \ +} while(0) + +#define DESTROY_SHCOPY(info) \ +do { \ + if (info.queue_start != info.queue_default) { \ + erts_free(info.queue_alloc_type, info.queue_start); \ + } \ + if (info.bitstore_start != info.bitstore_default) { \ + erts_free(info.bitstore_alloc_type, info.bitstore_start); \ + } \ + if (info.shtable_start != info.shtable_default) { \ + erts_free(info.shtable_alloc_type, info.shtable_start); \ + } \ +} while(0) + /* copy.c */ Eterm copy_object_x(Eterm, Process*, Uint); #define copy_object(Term, Proc) copy_object_x(Term,Proc,0) Uint size_object(Eterm); -Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); +Uint copy_shared_calculate(Eterm, erts_shcopy_t*); +Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*); + +Uint size_shared(Eterm); + +Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint* bsz); +#define copy_struct(Obj,Sz,HPP,OH) \ + copy_struct_x(Obj,Sz,HPP,OH,NULL) Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 1b0c617632..56a04f9b7f 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -7506,15 +7506,15 @@ int null_func(void) } int -erl_drv_putenv(char *key, char *value) +erl_drv_putenv(const char *key, char *value) { - return erts_sys_putenv_raw(key, value); + return erts_sys_putenv_raw((char*)key, value); } int -erl_drv_getenv(char *key, char *value, size_t *value_size) +erl_drv_getenv(const char *key, char *value, size_t *value_size) { - return erts_sys_getenv_raw(key, value, value_size); + return erts_sys_getenv_raw((char*)key, value, value_size); } /* get heart_port diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 90e16ca14f..2170d416c8 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -595,7 +595,6 @@ Uint erts_sys_misc_mem_sz(void); /* Io constants to erts_print and erts_putc */ #define ERTS_PRINT_STDERR (2) #define ERTS_PRINT_STDOUT (1) -#define ERTS_PRINT_INVALID (0) /* Don't want to use 0 since CBUF was 0 */ #define ERTS_PRINT_FILE (-1) #define ERTS_PRINT_SBUF (-2) #define ERTS_PRINT_SNBUF (-3) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index c3735683bb..ef851d840d 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -258,6 +258,31 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes) s->psp = s->pstart + sp_offs; } +/* + * Helper function for the EQUEUE macros defined in global.h. + */ + +void +erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue) +{ + Uint old_size = (q->end - q->start); + Uint new_size = old_size * 2; + Uint first_part = (q->end - q->front); + Uint second_part = (q->back - q->start); + Eterm* new_ptr = erts_alloc(q->alloc_type, new_size*sizeof(Eterm)); + ASSERT(q->back == q->front); // of course the queue is full now! + if (first_part > 0) + sys_memcpy(new_ptr, q->front, first_part*sizeof(Eterm)); + if (second_part > 0) + sys_memcpy(new_ptr+first_part, q->start, second_part*sizeof(Eterm)); + if (q->start != default_equeue) + erts_free(q->alloc_type, q->start); + q->start = new_ptr; + q->end = q->start + new_size; + q->front = q->start; + q->back = q->start + old_size; +} + /* CTYPE macros */ #define LATIN1 @@ -388,9 +413,6 @@ erts_print(int to, void *arg, char *format, ...) case ERTS_PRINT_DSBUF: res = erts_vdsprintf((erts_dsprintf_buf_t *) arg, format, arg_list); break; - case ERTS_PRINT_INVALID: - res = -EINVAL; - break; default: res = erts_vfdprintf((int) to, format, arg_list); break; diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 2cb4662fc3..a82abc3e9f 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -2575,7 +2575,6 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) case FILE_CLOSE_ON_PORT_EXIT: /* See file_stop. However this is never invoked after the port is killed. */ free_data(data); - EF_FREE(desc); desc = NULL; /* This is it for this port, so just send dtrace and return, avoid doing anything to the freed data */ DTRACE6(efile_drv_return, sched_i1, sched_i2, sched_utag, diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 1e3360c2b1..e3f5060117 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2013. All Rights Reserved. + * Copyright Ericsson AB 1997-2015. 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. @@ -5762,9 +5762,9 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) int arg_sz; enum PacketParseType old_htype = desc->htype; int old_active = desc->active; - int propagate = 0; /* Set to 1 if failure to set this option - should be propagated to erlang (not all - errors can be propagated for BC reasons) */ + int propagate; /* Set to 1 if failure to set this option + should be propagated to erlang (not all + errors can be propagated for BC reasons) */ int res; #ifdef HAVE_SCTP /* SCTP sockets are treated completely separately: */ @@ -5781,6 +5781,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) arg_ptr = (char*) &ival; arg_sz = sizeof(ival); proto = SOL_SOCKET; + propagate = 0; switch(opt) { case INET_LOPT_HEADER: diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index bb8a3f041f..69d4ea10c2 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -198,7 +198,7 @@ static void do_init(void) #define INIT() do { if (!init_done()) do_init(); } while (0) #endif /* __DARWIN__ */ -#if !defined(__GLIBC__) && !defined(__DARWIN__) && !defined(__NetBSD__) +#if defined(__sun__) /* * Assume Solaris/x86 2.8. * There is a number of sigaction() procedures in libc: @@ -232,7 +232,34 @@ static void do_init(void) } #define _NSIG NSIG #define INIT() do { if (!init_done()) do_init(); } while (0) -#endif /* not glibc or darwin */ +#endif /* __sun__ */ + +#if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__sun__)) +/* + * Unknown libc -- assume musl. Note: musl deliberately does not provide a musl-specific + * feature test macro, so we cannot check for it. + * + * sigaction is a weak alias for __sigaction, which is a wrapper for __libc_sigaction. + * There are libc-internal calls to __libc_sigaction which install handlers, so we must + * override __libc_sigaction rather than __sigaction. + */ +#include <dlfcn.h> +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +#define __SIGACTION __libc_sigaction +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "__libc_sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym"); + abort(); +} +#ifndef _NSIG +#define _NSIG NSIG +#endif +#define INIT() do { if (!init_done()) do_init(); } while (0) +#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __sun__) */ #if !defined(__NetBSD__) /* diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h index 6d8aef822e..bc2c681876 100644 --- a/erts/emulator/sys/common/erl_poll.h +++ b/erts/emulator/sys/common/erl_poll.h @@ -122,7 +122,7 @@ typedef Uint32 ErtsPollEvents; #endif #define ERTS_POLL_EV_E2N(EV) \ - ((__uint32_t) (EV)) + ((uint32_t) (EV)) #define ERTS_POLL_EV_N2E(EV) \ ((ErtsPollEvents) (EV)) diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c index 9a5557e93d..7c24a77e31 100644 --- a/erts/emulator/sys/win32/erl_win32_sys_ddll.c +++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c @@ -52,7 +52,8 @@ void erl_sys_ddll_init(void) { #define ERL_NIF_API_FUNC_DECL(RET,NAME,ARGS) nif_callbacks.NAME = NAME #include "erl_nif_api_funcs.h" #undef ERL_NIF_API_FUNC_DECL - + nif_callbacks.erts_alc_test = erts_alc_test; + return; } diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index 5e62320be4..baac7c903e 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -145,8 +145,8 @@ WDD_TYPEDEF(ErlDrvTid, erl_drv_thread_self, (void)); WDD_TYPEDEF(int, erl_drv_equal_tids, (ErlDrvTid tid1, ErlDrvTid tid2)); WDD_TYPEDEF(void, erl_drv_thread_exit, (void *resp)); WDD_TYPEDEF(int, erl_drv_thread_join, (ErlDrvTid, void **respp)); -WDD_TYPEDEF(int, erl_drv_putenv, (char *key, char *value)); -WDD_TYPEDEF(int, erl_drv_getenv, (char *key, char *value, size_t *value_size)); +WDD_TYPEDEF(int, erl_drv_putenv, (const char *key, char *value)); +WDD_TYPEDEF(int, erl_drv_getenv, (const char *key, char *value, size_t *value_size)); typedef struct { WDD_FTYPE(null_func) *null_func; diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 3ad1b88b2d..516bc873a5 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -31,7 +31,8 @@ rbtree/1, mseg_clear_cache/1, erts_mmap/1, - cpool/1]). + cpool/1, + migration/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -43,7 +44,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, coalesce, threads, realloc_copy, bucket_index, - bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool]. + bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration]. groups() -> []. @@ -64,7 +65,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), - [{watchdog, Dog},{testcase, Case}|Config]. + [{watchdog, Dog}, {testcase, Case}, {debug,false} | Config]. end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), @@ -112,6 +113,14 @@ cpool(suite) -> []; cpool(doc) -> []; cpool(Cfg) -> ?line drv_case(Cfg). +migration(Cfg) -> + case erlang:system_info(smp_support) of + true -> + drv_case(Cfg, concurrent, "+MZe true"); + false -> + {skipped, "No smp"} + end. + erts_mmap(Config) when is_list(Config) -> case ?t:os_type() of {unix, _} -> @@ -173,18 +182,17 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> %% %% drv_case(Config) -> - drv_case(Config, ""). + drv_case(Config, one_shot, ""). -drv_case(Config, Command) when is_list(Config), - is_list(Command) -> +drv_case(Config, Mode, NodeOpts) when is_list(Config) -> case ?t:os_type() of {Family, _} when Family == unix; Family == win32 -> - ?line {ok, Node} = start_node(Config), + ?line {ok, Node} = start_node(Config, NodeOpts), ?line Self = self(), ?line Ref = make_ref(), ?line spawn_link(Node, fun () -> - Res = run_drv_case(Config, Command), + Res = run_drv_case(Config, Mode), Self ! {Ref, Res} end), ?line Result = receive {Ref, Rslt} -> Rslt end, @@ -196,49 +204,172 @@ drv_case(Config, Command) when is_list(Config), | io_lib:format("~p",[SkipOs])])} end. -run_drv_case(Config, Command) -> - ?line DataDir = ?config(data_dir,Config), - ?line CaseName = ?config(testcase,Config), - case erl_ddll:load_driver(DataDir, CaseName) of - ok -> ok; - {error, Error} -> - io:format("~s\n", [erl_ddll:format_error(Error)]), - ?line ?t:fail() +run_drv_case(Config, Mode) -> + DataDir = ?config(data_dir,Config), + CaseName = ?config(testcase,Config), + File = filename:join(DataDir, CaseName), + {ok,CaseName,Bin} = compile:file(File, [binary,return_errors]), + {module,CaseName} = erlang:load_module(CaseName,Bin), + print_stats(CaseName), + ok = CaseName:init(File), + + SlaveState = slave_init(CaseName), + case Mode of + one_shot -> + Result = one_shot(CaseName); + + concurrent -> + Result = concurrent(CaseName) end, - ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), - ?line true = is_port(Port), - ?line Port ! {self(), {command, Command}}, - ?line Result = receive_drv_result(Port, CaseName), - ?line Port ! {self(), close}, - ?line receive - {Port, closed} -> - ok - end, - ?line ok = erl_ddll:unload_driver(CaseName), - ?line Result. - -receive_drv_result(Port, CaseName) -> - ?line receive - {print, Port, CaseName, Str} -> - ?line ?t:format("~s", [Str]), - ?line receive_drv_result(Port, CaseName); - {'EXIT', Port, Error} -> - ?line ?t:fail(Error); - {'EXIT', error, Error} -> - ?line ?t:fail(Error); - {failed, Port, CaseName, Comment} -> - ?line ?t:fail(Comment); - {skipped, Port, CaseName, Comment} -> - ?line {skipped, Comment}; - {succeeded, Port, CaseName, ""} -> - ?line succeeded; - {succeeded, Port, CaseName, Comment} -> - ?line {comment, Comment} - end. - -start_node(Config) -> - start_node(Config, []). + + wait_for_memory_deallocations(), + print_stats(CaseName), + + true = erlang:delete_module(CaseName), + slave_end(SlaveState), + Result. + +slave_init(migration) -> + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end; +slave_init(_) -> []. + +slave_end(Apps) -> + lists:foreach(fun (A) -> application:stop(A) end, Apps). + +wait_for_memory_deallocations() -> + try + erts_debug:set_internal_state(wait, deallocations) + catch + error:undef -> + erts_debug:set_internal_state(available_internal_state, true), + wait_for_memory_deallocations() + end. + +print_stats(migration) -> + {Btot,Ctot} = lists:foldl(fun({instance,Inr,Istats}, {Bacc,Cacc}) -> + {mbcs,MBCS} = lists:keyfind(mbcs, 1, Istats), + Btup = lists:keyfind(blocks, 1, MBCS), + Ctup = lists:keyfind(carriers, 1, MBCS), + io:format("{instance,~p,~p,~p}\n", [Inr, Btup, Ctup]), + {tuple_add(Bacc,Btup),tuple_add(Cacc,Ctup)}; + (_, Acc) -> Acc + end, + {{blocks,0,0,0},{carriers,0,0,0}}, + erlang:system_info({allocator,test_alloc})), + + io:format("Number of blocks : ~p\n", [Btot]), + io:format("Number of carriers: ~p\n", [Ctot]); + +print_stats(_) -> ok. + +tuple_add(T1, T2) -> + list_to_tuple(lists:zipwith(fun(E1,E2) when is_number(E1), is_number(E2) -> + E1 + E2; + (A,A) -> + A + end, + tuple_to_list(T1), tuple_to_list(T2))). + + +one_shot(CaseName) -> + State = CaseName:start({1, 0, erlang:system_info(build_type)}), + Result0 = CaseName:run(State), + false = (Result0 =:= continue), + Result1 = handle_result(State, Result0), + CaseName:stop(State), + Result1. + + +many_shot(CaseName, I, Mem) -> + State = CaseName:start({I, Mem, erlang:system_info(build_type)}), + Result1 = repeat_while(fun() -> + Result0 = CaseName:run(State), + handle_result(State, Result0) + end, + 10*1000, I), + CaseName:stop(State), + flush_log(), + Result1. + +concurrent(CaseName) -> + NSched = erlang:system_info(schedulers), + Mem = (free_memory() * 3) div 4, + PRs = lists:map(fun(I) -> spawn_opt(fun() -> + many_shot(CaseName, I, + Mem div NSched) + end, + [monitor, {scheduler,I}]) + end, + lists:seq(1, NSched)), + lists:foreach(fun({Pid,Ref}) -> + receive {'DOWN', Ref, process, Pid, Reason} -> + Reason + end + end, + PRs), + ok. + +repeat_while(Fun, Timeout, I) -> + TRef = erlang:start_timer(Timeout, self(), timeout), + R = repeat_while_loop(Fun, TRef, I), + erlang:cancel_timer(TRef, [{async,true},{info,false}]), + R. + +repeat_while_loop(Fun, TRef, I) -> + receive + {timeout, TRef, timeout} -> + io:format("~p: Timeout, enough is enough.",[I]), + succeeded + after 0 -> + %%io:format("~p calls fun\n", [self()]), + case Fun() of + continue -> repeat_while_loop(Fun, TRef, I); + R -> R + end + end. + +flush_log() -> + receive + {print, Str} -> + ?t:format("~s", [Str]), + flush_log() + after 0 -> + ok + end. + +handle_result(_State, Result0) -> + flush_log(), + case Result0 of + {'EXIT', Error} -> + ?line ?t:fail(Error); + {'EXIT', error, Error} -> + ?line ?t:fail(Error); + {failed, Comment} -> + ?line ?t:fail(Comment); + {skipped, Comment} -> + ?line {skipped, Comment}; + {succeeded, ""} -> + ?line succeeded; + {succeeded, Comment} -> + ?line {comment, Comment}; + continue -> + continue + end. + start_node(Config, Opts) when is_list(Config), is_list(Opts) -> + case ?config(debug,Config) of + true -> {ok, node()}; + _ -> start_node_1(Config, Opts) + end. + +start_node_1(Config, Opts) -> Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" @@ -249,5 +380,27 @@ start_node(Config, Opts) when is_list(Config), is_list(Opts) -> ++ integer_to_list(erlang:unique_integer([positive]))), ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]). +stop_node(Node) when Node =:= node() -> ok; stop_node(Node) -> ?t:stop_node(Node). + +free_memory() -> + %% Free memory in MB. + try + SMD = memsup:get_system_memory_data(), + {value, {free_memory, Free}} = lists:keysearch(free_memory, 1, SMD), + TotFree = (Free + + case lists:keysearch(cached_memory, 1, SMD) of + {value, {cached_memory, Cached}} -> Cached; + false -> 0 + end + + case lists:keysearch(buffered_memory, 1, SMD) of + {value, {buffered_memory, Buffed}} -> Buffed; + false -> 0 + end), + TotFree div (1024*1024) + catch + error : undef -> + ?t:fail({"os_mon not built"}) + end. + diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src index a441fe946b..e31de54e1b 100644 --- a/erts/emulator/test/alloc_SUITE_data/Makefile.src +++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src @@ -25,7 +25,8 @@ TEST_DRVS = basic@dll@ \ bucket_mask@dll@ \ rbtree@dll@ \ mseg_clear_cache@dll@ \ - cpool@dll@ + cpool@dll@ \ + migration@dll@ CC = @CC@ LD = @LD@ diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index 1d6b2f4907..97ee58cdad 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -20,9 +20,20 @@ #ifndef ALLOCATOR_TEST_H__ #define ALLOCATOR_TEST_H__ -typedef ErlDrvUInt Ulong; +#if SIZEOF_VOID_P == SIZEOF_INT +typedef unsigned int Ulong; +#elif SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long Ulong; +#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef unsigned long long Ulong; +#else +# error No pointer sized integer type found ??? +#endif -#ifndef __WIN32__ +#ifdef __WIN32__ +typedef Ulong erts_alc_test_Fn(Ulong, Ulong, Ulong, Ulong); +# define erts_alc_test ((erts_alc_test_Fn*)WinDynNifCallbacks.erts_alc_test) +#else Ulong erts_alc_test(Ulong, Ulong, Ulong, Ulong); #endif @@ -85,6 +96,7 @@ typedef void* erts_cond; #define CPOOL_DELETE(A,B) ((Carrier_t *) ALC_TEST2(0x022, (A), (B))) #define CPOOL_IS_EMPTY(A) ((int) ALC_TEST1(0x023, (A))) #define CPOOL_IS_IN_POOL(A,B) ((int) ALC_TEST2(0x024, (A), (B))) +#define UMEM2BLK_TEST(P) ((Block_t*) ALC_TEST1(0x025, (P))) /* From erl_goodfit_alloc.c */ #define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S))) @@ -142,5 +154,9 @@ typedef void* erts_cond; #define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T))) #define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R))) #define IS_SMP_ENABLED ((int) ALC_TEST0(0xf13)) +#define ALLOC_TEST(S) ((void*) ALC_TEST1(0xf14, (S))) +#define FREE_TEST(P) ((void) ALC_TEST1(0xf15, (P))) +#define SET_TEST_MBC_USER_HEADER(SZ,CMBC,DMBC) ((int)ALC_TEST3(0xf16, (SZ), (CMBC), (DMBC))) +#define GET_TEST_MBC_SIZE() ((int) ALC_TEST0(0xf17)) #endif diff --git a/erts/emulator/test/alloc_SUITE_data/basic.c b/erts/emulator/test/alloc_SUITE_data/basic.c index 323a24a11f..debb3d7ebe 100644 --- a/erts/emulator/test/alloc_SUITE_data/basic.c +++ b/erts/emulator/test/alloc_SUITE_data/basic.c @@ -60,3 +60,6 @@ testcase_cleanup(TestCaseState_t *tcs) if (tcs->extra) STOP_ALC((Allctr_t *) tcs->extra); } + +ERL_NIF_INIT(basic, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/basic.erl b/erts/emulator/test/alloc_SUITE_data/basic.erl new file mode 100644 index 0000000000..a018fd5582 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/basic.erl @@ -0,0 +1,10 @@ +-module(basic). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.c b/erts/emulator/test/alloc_SUITE_data/bucket_index.c index c13f229049..45cb53fbf7 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_index.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.c @@ -113,3 +113,5 @@ test_it(TestCaseState_t *tcs, unsigned sbct) sbct ? sbct_buf : "default"); } +ERL_NIF_INIT(bucket_index, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.erl b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl new file mode 100644 index 0000000000..c54f54e2f5 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl @@ -0,0 +1,10 @@ +-module(bucket_index). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c index 8d6166771e..c94c265f4e 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c @@ -52,7 +52,7 @@ testcase_run(TestCaseState_t *tcs) typedef struct linked_block { struct linked_block* next; }Linked; - Linked* link; + Linked* link = NULL; Linked* fence_list; Linked* pad_list; void* tmp; @@ -183,3 +183,5 @@ testcase_run(TestCaseState_t *tcs) tcs->extra = NULL; } +ERL_NIF_INIT(bucket_mask, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl new file mode 100644 index 0000000000..589a50e1fa --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl @@ -0,0 +1,10 @@ +-module(bucket_mask). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c index 0a5e0c5b0e..7791409a34 100644 --- a/erts/emulator/test/alloc_SUITE_data/coalesce.c +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -317,3 +317,6 @@ testcase_cleanup(TestCaseState_t *tcs) if (tcs->extra) STOP_ALC((Allctr_t *) tcs->extra); } + +ERL_NIF_INIT(coalesce, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.erl b/erts/emulator/test/alloc_SUITE_data/coalesce.erl new file mode 100644 index 0000000000..453c726c4e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.erl @@ -0,0 +1,10 @@ +-module(coalesce). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c index 75c2bc13ae..73026cc758 100644 --- a/erts/emulator/test/alloc_SUITE_data/cpool.c +++ b/erts/emulator/test/alloc_SUITE_data/cpool.c @@ -86,13 +86,13 @@ thread_func(void *arg) for (i = 0; i < (TEST_NO_CARRIERS_PER_THREAD+TEST_CARRIERS_OFFSET); i++) { int d; if (i < TEST_NO_CARRIERS_PER_THREAD) { - CPOOL_INSERT(alloc, crr[i]); + (void) CPOOL_INSERT(alloc, crr[i]); if ((i & 0x7) == 0) FATAL_ASSERT(CPOOL_IS_IN_POOL(alloc, crr[i])); } d = i-TEST_CARRIERS_OFFSET; if (d >= 0) { - CPOOL_DELETE(alloc, crr[d]); + (void) CPOOL_DELETE(alloc, crr[d]); if ((d & 0x7) == 0) FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[d])); } @@ -129,7 +129,7 @@ testcase_run(TestCaseState_t *tcs) for (c = 0; c < TEST_NO_CARRIERS_PER_THREAD; c++) { Carrier_t *crr = (Carrier_t *) p; p += zcrr_sz; - ZERO_CRR_INIT(alloc, crr); + (void) ZERO_CRR_INIT(alloc, crr); threads[t].crr[c] = crr; } } @@ -156,3 +156,6 @@ testcase_run(TestCaseState_t *tcs) ASSERT(tcs, no_threads == TEST_NO_THREADS); } + +ERL_NIF_INIT(cpool, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.erl b/erts/emulator/test/alloc_SUITE_data/cpool.erl new file mode 100644 index 0000000000..89053471fa --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/cpool.erl @@ -0,0 +1,10 @@ +-module(cpool). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c new file mode 100644 index 0000000000..b006360043 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/migration.c @@ -0,0 +1,343 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Test the carrier migration logic + */ + +#ifndef __WIN32__ +#include <sys/types.h> +#include <unistd.h> +#include <errno.h> +#endif +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include "testcase_driver.h" +#include "allocator_test.h" + +#define FATAL_ASSERT(A) \ + ((void) ((A) \ + ? 1 \ + : (fatal_assert_failed(#A, \ + (char *) __FILE__, \ + __LINE__), \ + 0))) + +static void +fatal_assert_failed(char* expr, char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "%s:%d: Assertion failed: %s\n", + file, line, expr); + fflush(stderr); + abort(); +} + + +char * +testcase_name(void) +{ + return "migration"; +} + +/* Turns out random_r() is a nonstandard glibc extension. +#define HAVE_RANDOM_R +*/ +#ifdef HAVE_RANDOM_R + +typedef struct { struct random_data rnd; char rndbuf[32]; } MyRandState; + +static void myrand_init(MyRandState* mrs, unsigned int seed) +{ + int res; + memset(&mrs->rnd, 0, sizeof(mrs->rnd)); + res = initstate_r(seed, mrs->rndbuf, sizeof(mrs->rndbuf), &mrs->rnd); + FATAL_ASSERT(res == 0); +} + +static int myrand(MyRandState* mrs) +{ + int32_t x; + int res = random_r(&mrs->rnd, &x); + FATAL_ASSERT(res == 0); + return (int)x; +} + +#else /* !HAVE_RANDOM_R */ + +typedef unsigned int MyRandState; + +static void myrand_init(MyRandState* mrs, unsigned int seed) +{ + *mrs = seed; +} + +static int myrand(MyRandState* mrs) +{ + /* Taken from rand(3) man page. + * Modified to return a full 31-bit value by using low half of *mrs as well. + */ + *mrs = (*mrs) * 1103515245 + 12345; + return (int) (((*mrs >> 16) | (*mrs << 16)) & ~(1 << 31)); +} + +#endif /* !HAVE_RANDOM_R */ + +#define MAX_BLOCK_PER_THR 200 +#define BLOCKS_PER_MBC 10 +#define MAX_ROUNDS 10000 + +typedef struct MyBlock_ { + struct MyBlock_* next; + struct MyBlock_** prevp; +} MyBlock; + +typedef struct { + MyBlock* blockv[MAX_BLOCK_PER_THR]; + MyRandState rand_state; + enum { GROWING, SHRINKING, CLEANUP, DONE } phase; + int nblocks; + int goal_nblocks; + int round; + int nr_of_migrations; + int nr_of_carriers; + int max_blocks_in_mbc; + int block_size; + int max_nblocks; +} MigrationState; + +typedef struct { + ErlNifMutex* mtx; + int nblocks; + MyBlock* first; + MigrationState* employer; +} MyCrrInfo; + + +static int crr_info_offset = -1; +static void (*orig_create_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier); +static void (*orig_destroying_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier); + +static void my_creating_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset); + if (orig_create_mbc_fn) + orig_create_mbc_fn(allctr, carrier); + + mci->mtx = enif_mutex_create("alloc_SUITE.migration"); + mci->nblocks = 0; + mci->first = NULL; + mci->employer = NULL; +} + +static void my_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset); + + FATAL_ASSERT(mci->nblocks == 0); + FATAL_ASSERT(mci->first == NULL); + enif_mutex_destroy(mci->mtx); + + if (orig_destroying_mbc_fn) + orig_destroying_mbc_fn(allctr, carrier); +} + +static int migration_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + void* creating_mbc_arg = (void*)my_creating_mbc; + void* destroying_mbc_arg = (void*)my_destroying_mbc; + + if (testcase_nif_init(env, priv_data, load_info)) + return -1; + + crr_info_offset = SET_TEST_MBC_USER_HEADER(sizeof(MyCrrInfo), + &creating_mbc_arg, + &destroying_mbc_arg); + FATAL_ASSERT(crr_info_offset >= 0); + orig_create_mbc_fn = creating_mbc_arg; + orig_destroying_mbc_fn = destroying_mbc_arg; + + return 0; +} + +static void add_block(MyBlock* p, MigrationState* state) +{ + MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset); + + enif_mutex_lock(mci->mtx); + if (++mci->nblocks > state->max_blocks_in_mbc) + state->max_blocks_in_mbc = mci->nblocks; + p->next = mci->first; + p->prevp = &mci->first; + mci->first = p; + if (p->next) + p->next->prevp = &p->next; + if (mci->employer != state) { + if (!mci->employer) { + FATAL_ASSERT(mci->nblocks == 1); + state->nr_of_carriers++; + } + else { + state->nr_of_migrations++; + } + mci->employer = state; + } + enif_mutex_unlock(mci->mtx); +} + +static void remove_block(MyBlock* p) +{ + MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset); + + enif_mutex_lock(mci->mtx); + mci->nblocks--; + if (p->next) + p->next->prevp = p->prevp; + *p->prevp = p->next; + enif_mutex_unlock(mci->mtx); +} + +static int rand_int(MigrationState* state, int low, int high) +{ + int x; + FATAL_ASSERT(high >= low); + x = myrand(&state->rand_state); + return low + (x % (high+1-low)); +} + + +static void do_cleanup(TestCaseState_t *tcs, MigrationState* state) +{ + if (state->nblocks == 0) { + state->phase = DONE; + testcase_printf(tcs, "%d: Done %d rounds", tcs->thr_nr, state->round); + testcase_printf(tcs, "%d: Cleanup all blocks", tcs->thr_nr); + testcase_printf(tcs, "%d: Empty carriers detected = %d", tcs->thr_nr, + state->nr_of_carriers); + testcase_printf(tcs, "%d: Migrations detected = %d", tcs->thr_nr, + state->nr_of_migrations); + testcase_printf(tcs, "%d: Max blocks in carrier = %d", tcs->thr_nr, + state->max_blocks_in_mbc); + } + else { + state->nblocks--; + if (state->blockv[state->nblocks]) { + remove_block(state->blockv[state->nblocks]); + FREE_TEST(state->blockv[state->nblocks]); + } + } +} + + +void +testcase_run(TestCaseState_t *tcs) +{ + MigrationState* state = (MigrationState*) tcs->extra; + + if (!tcs->extra) { + if (!IS_SMP_ENABLED) + testcase_skipped(tcs, "No SMP support"); + + tcs->extra = enif_alloc(sizeof(MigrationState)); + state = (MigrationState*) tcs->extra; + memset(state->blockv, 0, sizeof(state->blockv)); + myrand_init(&state->rand_state, tcs->thr_nr); + state->phase = GROWING; + state->nblocks = 0; + state->round = 0; + state->nr_of_migrations = 0; + state->nr_of_carriers = 0; + state->max_blocks_in_mbc = 0; + state->block_size = GET_TEST_MBC_SIZE() / (BLOCKS_PER_MBC+1); + if (MAX_BLOCK_PER_THR * state->block_size < tcs->free_mem) { + state->max_nblocks = MAX_BLOCK_PER_THR; + } else { + state->max_nblocks = tcs->free_mem / state->block_size; + } + state->goal_nblocks = rand_int(state, 1, state->max_nblocks); + } + + switch (state->phase) { + case GROWING: { + MyBlock* p; + FATAL_ASSERT(!state->blockv[state->nblocks]); + p = ALLOC_TEST(rand_int(state, state->block_size/2, state->block_size)); + FATAL_ASSERT(p); + add_block(p, state); + state->blockv[state->nblocks] = p; + if (++state->nblocks >= state->goal_nblocks) { + /*testcase_printf(tcs, "%d: Grown to %d blocks", tcs->thr_nr, state->nblocks);*/ + state->phase = SHRINKING; + state->goal_nblocks = rand_int(state, 0, state->goal_nblocks-1); + } + else + FATAL_ASSERT(!state->blockv[state->nblocks]); + break; + } + case SHRINKING: { + int ix = rand_int(state, 0, state->nblocks-1); + FATAL_ASSERT(state->blockv[ix]); + remove_block(state->blockv[ix]); + FREE_TEST(state->blockv[ix]); + state->blockv[ix] = state->blockv[--state->nblocks]; + state->blockv[state->nblocks] = NULL; + + if (state->nblocks <= state->goal_nblocks) { + /*testcase_printf(tcs, "%d: Shrunk to %d blocks", tcs->thr_nr, state->nblocks);*/ + if (++state->round >= MAX_ROUNDS) { + state->phase = CLEANUP; + } else { + state->phase = GROWING; + state->goal_nblocks = rand_int(state, state->goal_nblocks+1, state->max_nblocks); + } + } + break; + } + case CLEANUP: + do_cleanup(tcs, state); + break; + + default: + FATAL_ASSERT(!"Invalid phase"); + } + + if (state->phase == DONE) { + } + else { + testcase_continue(tcs); + } +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + MigrationState* state = (MigrationState*) tcs->extra; + + while (state->phase != DONE) + do_cleanup(tcs, state); + + enif_free(tcs->extra); + tcs->extra = NULL; +} + + +ERL_NIF_INIT(migration, testcase_nif_funcs, migration_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/migration.erl b/erts/emulator/test/alloc_SUITE_data/migration.erl new file mode 100644 index 0000000000..440a99becd --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/migration.erl @@ -0,0 +1,10 @@ +-module(migration). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c index 9c03f3a331..e5df3d647f 100644 --- a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c @@ -101,3 +101,6 @@ testcase_cleanup(TestCaseState_t *tcs) tcs->extra = NULL; } } + +ERL_NIF_INIT(mseg_clear_cache, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl new file mode 100644 index 0000000000..befd6c2e8e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl @@ -0,0 +1,10 @@ +-module(mseg_clear_cache). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c index 8d4d5535a8..38bbbdf90c 100644 --- a/erts/emulator/test/alloc_SUITE_data/rbtree.c +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -20,7 +20,7 @@ #include "testcase_driver.h" #include "allocator_test.h" -#define NO_BLOCKS 100000 +int NO_BLOCKS; #define RIGHT_VISITED (1 << 0) #define LEFT_VISITED (1 << 1) @@ -265,9 +265,10 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) ASSERT(tcs, curr_blacks == 0); ASSERT(tcs, i == -1); + /* testcase_printf(tcs, "Red-Black Tree OK! Max depth = %d; " "Black depth = %d\n", max_i+1, blacks < 0 ? 0 : blacks); - + */ return res; } @@ -468,6 +469,12 @@ testcase_run(TestCaseState_t *tcs) Allctr_t *a; rbtree_test_data *td; + NO_BLOCKS = 100*1000; + if (enif_is_identical(tcs->build_type, + enif_make_atom(tcs->curr_env,"valgrind"))) { + NO_BLOCKS /= 10; + } + /* Best fit... */ testcase_printf(tcs, "Setup...\n"); @@ -577,3 +584,6 @@ testcase_run(TestCaseState_t *tcs) testcase_printf(tcs, "aoffcaobf test succeeded!\n"); } + +ERL_NIF_INIT(rbtree, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.erl b/erts/emulator/test/alloc_SUITE_data/rbtree.erl new file mode 100644 index 0000000000..f5b7120ff2 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.erl @@ -0,0 +1,10 @@ +-module(rbtree). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c index e405f06225..c4147eb00d 100644 --- a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c @@ -278,3 +278,5 @@ testcase_cleanup(TestCaseState_t *tcs) STOP_ALC((Allctr_t *) tcs->extra); } +ERL_NIF_INIT(realloc_copy, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl new file mode 100644 index 0000000000..cc6617bf64 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl @@ -0,0 +1,10 @@ +-module(realloc_copy). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c index bc674c56b7..7dcca544e5 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c @@ -23,141 +23,147 @@ #include <stdarg.h> #include <setjmp.h> #include <string.h> +#include <limits.h> #ifdef __WIN32__ -#undef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 1 -#define vsnprintf _vsnprintf +static void my_vsnprintf(char *outBuf, size_t size, const char *format, va_list ap) +{ + _vsnprintf(outBuf, size, format, ap); + outBuf[size-1] = 0; /* be sure string is terminated */ +} +#elif defined(HAVE_VSNPRINTF) +# define my_vsnprintf(B,S,F,A) (void)vsnprintf(B,S,F,A) +#else +# warning Using unsafe 'vsprintf' without buffer overflow protection +# define my_vsnprintf(B,S,F,A) (void)vsprintf(B,F,A) #endif -#ifndef HAVE_VSNPRINTF -#define HAVE_VSNPRINTF 0 -#endif +static void my_snprintf(char *outBuf, size_t size, const char *format, ...) +{ + va_list ap; + va_start(ap, format); + my_vsnprintf(outBuf, size, format, ap); + va_end(ap); +} #define COMMENT_BUF_SZ 4096 #define TESTCASE_FAILED 0 #define TESTCASE_SKIPPED 1 #define TESTCASE_SUCCEEDED 2 +#define TESTCASE_CONTINUE 3 typedef struct { TestCaseState_t visible; - ErlDrvPort port; - ErlDrvTermData port_id; int result; - jmp_buf done_jmp_buf; + jmp_buf* done_jmp_buf; char *comment; char comment_buf[COMMENT_BUF_SZ]; } InternalTestCaseState_t; -ErlDrvData testcase_drv_start(ErlDrvPort port, char *command); -void testcase_drv_stop(ErlDrvData drv_data); -void testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); - -static ErlDrvEntry testcase_drv_entry = { - NULL, - testcase_drv_start, - testcase_drv_stop, - testcase_drv_run, - NULL, - NULL, - "testcase_drv", - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - NULL, - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - 0, - NULL, - NULL, - NULL +ERL_NIF_TERM testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +ErlNifFunc testcase_nif_funcs[] = +{ + {"start", 1, testcase_nif_start}, + {"run", 1, testcase_nif_run}, + {"stop", 1, testcase_nif_stop} }; +static ErlNifResourceType* testcase_rt; +static ERL_NIF_TERM print_atom; -DRIVER_INIT(testcase_drv) +int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { - testcase_drv_entry.driver_name = testcase_name(); - return &testcase_drv_entry; + testcase_rt = enif_open_resource_type(env, NULL, "testcase_rt", NULL, + ERL_NIF_RT_CREATE, NULL); + + print_atom = enif_make_atom(env, "print"); + return 0; } -ErlDrvData -testcase_drv_start(ErlDrvPort port, char *command) -{ +ERL_NIF_TERM +testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ /* (ThrNr, FreeMeg, BuildType) */ + ERL_NIF_TERM ret; InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) - driver_alloc(sizeof(InternalTestCaseState_t)); - if (!itcs) { - return ERL_DRV_ERROR_GENERAL; + enif_alloc_resource(testcase_rt, sizeof(InternalTestCaseState_t)); + int free_megabyte; + const int max_megabyte = INT_MAX / (1024*1024); + const ERL_NIF_TERM* tpl; + int tpl_arity; + + if (!itcs + || !enif_get_tuple(env, argv[0], &tpl_arity, &tpl) + || tpl_arity != 3 + || !enif_get_int(env, tpl[0], &itcs->visible.thr_nr) + || !enif_get_int(env, tpl[1], &free_megabyte)) { + enif_make_badarg(env); } - + itcs->visible.free_mem = (free_megabyte < max_megabyte ? + free_megabyte : max_megabyte) * (1024*1024); itcs->visible.testcase_name = testcase_name(); + itcs->visible.build_type = tpl[2]; itcs->visible.extra = NULL; - itcs->port = port; - itcs->port_id = driver_mk_port(port); itcs->result = TESTCASE_FAILED; itcs->comment = ""; - return (ErlDrvData) itcs; + ret = enif_make_resource(env, itcs); + enif_release_resource(itcs); + return ret; } -void -testcase_drv_stop(ErlDrvData drv_data) +ERL_NIF_TERM +testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - testcase_cleanup((TestCaseState_t *) drv_data); - driver_free((void *) drv_data); + InternalTestCaseState_t *itcs; + if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs)) + return enif_make_badarg(env); + testcase_cleanup(&itcs->visible); + return enif_make_atom(env,"ok"); } -void -testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +ERL_NIF_TERM +testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; - ErlDrvTermData result_atom; - ErlDrvTermData msg[12]; + InternalTestCaseState_t *itcs; + const char* result_atom; + jmp_buf the_jmp_buf; + + if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs)) + return enif_make_badarg(env); - itcs->visible.command = buf; - itcs->visible.command_len = len; + itcs->visible.curr_env = env; - if (setjmp(itcs->done_jmp_buf) == 0) { - testcase_run((TestCaseState_t *) itcs); + /* For some unknown reason, first call to setjmp crashes on win64 + * when jmp_buf is allocated as part of the resource. But it works when + * allocated on stack. It used to work when this was a driver. + */ + itcs->done_jmp_buf = &the_jmp_buf; + + if (setjmp(the_jmp_buf) == 0) { + testcase_run(&itcs->visible); itcs->result = TESTCASE_SUCCEEDED; } switch (itcs->result) { - case TESTCASE_SUCCEEDED: - result_atom = driver_mk_atom("succeeded"); - break; - case TESTCASE_SKIPPED: - result_atom = driver_mk_atom("skipped"); - break; - case TESTCASE_FAILED: + case TESTCASE_CONTINUE: + return enif_make_atom(env, "continue"); + + case TESTCASE_SUCCEEDED: result_atom = "succeeded"; break; + case TESTCASE_SKIPPED: result_atom = "skipped"; break; + case TESTCASE_FAILED: result_atom = "failed"; break; default: - result_atom = driver_mk_atom("failed"); - break; + result_atom = "failed"; + my_snprintf(itcs->comment_buf, sizeof(itcs->comment_buf), + "Unexpected test result code %d.", itcs->result); + itcs->comment = itcs->comment_buf; } - msg[0] = ERL_DRV_ATOM; - msg[1] = (ErlDrvTermData) result_atom; - - msg[2] = ERL_DRV_PORT; - msg[3] = itcs->port_id; - - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (ErlDrvTermData) itcs->comment; - msg[8] = (ErlDrvTermData) strlen(itcs->comment); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (ErlDrvTermData) 4; - - erl_drv_output_term(itcs->port_id, msg, 11); + return enif_make_tuple2(env, enif_make_atom(env, result_atom), + enif_make_string(env, itcs->comment, ERL_NIF_LATIN1)); } int @@ -172,34 +178,22 @@ testcase_assertion_failed(TestCaseState_t *tcs, void testcase_printf(TestCaseState_t *tcs, char *frmt, ...) { - InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; - ErlDrvTermData msg[12]; + InternalTestCaseState_t* itcs = (InternalTestCaseState_t*)tcs; + ErlNifPid pid; + ErlNifEnv* msg_env = enif_alloc_env(); + ERL_NIF_TERM msg; va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); - msg[0] = ERL_DRV_ATOM; - msg[1] = (ErlDrvTermData) driver_mk_atom("print"); + msg = enif_make_tuple2(msg_env, print_atom, + enif_make_string(msg_env, itcs->comment_buf, ERL_NIF_LATIN1)); - msg[2] = ERL_DRV_PORT; - msg[3] = itcs->port_id; + enif_send(itcs->visible.curr_env, enif_self(itcs->visible.curr_env, &pid), + msg_env, msg); - msg[4] = ERL_DRV_ATOM; - msg[5] = driver_mk_atom(itcs->visible.testcase_name); - - msg[6] = ERL_DRV_STRING; - msg[7] = (ErlDrvTermData) itcs->comment_buf; - msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf); - - msg[9] = ERL_DRV_TUPLE; - msg[10] = (ErlDrvTermData) 4; - - erl_drv_output_term(itcs->port_id, msg, 11); + enif_free_env(msg_env); } @@ -208,17 +202,13 @@ void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...) InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_SUCCEEDED; itcs->comment = itcs->comment_buf; - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); } void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) @@ -226,17 +216,20 @@ void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_SKIPPED; itcs->comment = itcs->comment_buf; - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); +} + +void testcase_continue(TestCaseState_t *tcs) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + itcs->result = TESTCASE_CONTINUE; + longjmp(*itcs->done_jmp_buf, 1); } void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) @@ -246,37 +239,33 @@ void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) size_t bufsz = sizeof(buf); va_list va; va_start(va, frmt); -#if HAVE_VSNPRINTF - vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); -#else - vsprintf(itcs->comment_buf, frmt, va); -#endif + my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); va_end(va); itcs->result = TESTCASE_FAILED; itcs->comment = itcs->comment_buf; - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 && strcmp("true", buf) == 0) { fprintf(stderr, "Testcase \"%s\" failed: %s\n", itcs->visible.testcase_name, itcs->comment); abort(); } - longjmp(itcs->done_jmp_buf, 1); + longjmp(*itcs->done_jmp_buf, 1); } void *testcase_alloc(size_t size) { - return driver_alloc(size); + return enif_alloc(size); } void *testcase_realloc(void *ptr, size_t size) { - return driver_realloc(ptr, size); + return enif_realloc(ptr, size); } void testcase_free(void *ptr) { - driver_free(ptr); + enif_free(ptr); } diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h index 5d17eaec64..f0ca91bd06 100644 --- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h @@ -20,13 +20,15 @@ #ifndef TESTCASE_DRIVER_H__ #define TESTCASE_DRIVER_H__ -#include "erl_driver.h" +#include "erl_nif.h" #include <stdlib.h> typedef struct { + ErlNifEnv* curr_env; char *testcase_name; - char *command; - int command_len; + int thr_nr; + int free_mem; /* in bytes */ + ERL_NIF_TERM build_type; /* opt, debug, valgrind, ... */ void *extra; } TestCaseState_t; @@ -34,9 +36,11 @@ typedef struct { ((void) ((B) ? 1 : testcase_assertion_failed((TCS), __FILE__, __LINE__, #B))) +int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); void testcase_printf(TestCaseState_t *tcs, char *frmt, ...); void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...); void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...); +void testcase_continue(TestCaseState_t *tcs); void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, char *assertion); @@ -45,8 +49,11 @@ void *testcase_realloc(void *ptr, size_t size); void testcase_free(void *ptr); +/* Implemented by testcase: */ char *testcase_name(void); void testcase_run(TestCaseState_t *tcs); void testcase_cleanup(TestCaseState_t *tcs); -#endif +extern ErlNifFunc testcase_nif_funcs[3]; + +#endif /* TESTCASE_DRIVER_H__ */ diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c index edad24ee6b..a8a6a23695 100644 --- a/erts/emulator/test/alloc_SUITE_data/threads.c +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -86,7 +86,7 @@ static void fail(int t_no, char *frmt, ...) tc_failed = 1; - if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 && strcmp("true", buf) == 0) { fprintf(stderr, "Testcase \"%s\" failed: %s\n", testcase_name(), err_buf); @@ -187,7 +187,6 @@ testcase_run(TestCaseState_t *tcs) for(i = 1; i <= NO_OF_THREADS; i++) { char *alc; - int res; threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; @@ -446,3 +445,6 @@ thread_func(void *arg) exit_thread(td->t_no, 1); return NULL; } + +ERL_NIF_INIT(threads, testcase_nif_funcs, testcase_nif_init, + NULL, NULL, NULL); diff --git a/erts/emulator/test/alloc_SUITE_data/threads.erl b/erts/emulator/test/alloc_SUITE_data/threads.erl new file mode 100644 index 0000000000..a7b4965f5e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/threads.erl @@ -0,0 +1,10 @@ +-module(threads). + +-export([init/1, start/1, run/1, stop/1]). + +init(File) -> + ok = erlang:load_nif(File, 0). + +start(_) -> erlang:nif_error(not_loaded). +run(_) -> erlang:nif_error(not_loaded). +stop(_) -> erlang:nif_error(not_loaded). diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 9f318a38be..1acc4538fb 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -26,7 +26,8 @@ t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1, - false_dependency/1,coverage/1,fun_confusion/1]). + false_dependency/1,coverage/1,fun_confusion/1, + t_copy_literals/1]). -define(line_trace, 1). -include_lib("test_server/include/test_server.hrl"). @@ -38,7 +39,7 @@ all() -> t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, constant_pools, constant_refc_binaries, false_dependency, - coverage, fun_confusion]. + coverage, fun_confusion, t_copy_literals]. groups() -> []. @@ -753,6 +754,80 @@ compile_load(Mod, Src, Ver) -> {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), ok. + +t_copy_literals(Config) when is_list(Config) -> + %% Compile the the literals module. + Data = ?config(data_dir, Config), + File = filename:join(Data, "literals"), + {ok,literals,Code} = compile:file(File, [report,binary]), + {module,literals} = erlang:load_module(literals, Code), + + N = 30, + Me = self(), + %% reload literals code every 567 ms + Rel = spawn_link(fun() -> reloader(literals,Code,567) end), + %% add new literal msgs to the loop every 789 ms + Sat = spawn_link(fun() -> saturate(Me,789) end), + %% run for 10s + _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end), + ok = chase_msg(N, Me), + %% cleanup + Rel ! done, + Sat ! done, + ok = flush(), + ok. + + +chase_msg(0, Pid) -> + chase_loop(Pid); +chase_msg(N, Master) -> + Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end), + chase_loop(Pid). + +chase_loop(Pid) -> + receive + done -> + Pid ! done, + ok; + {_From,Msg} -> + Pid ! {self(), Msg}, + ok = traverse(Msg), + chase_loop(Pid) + end. + +saturate(Pid,Time) -> + Es = [msg1,msg2,msg3,msg4,msg5], + Msg = [literals:E()||E <- Es], + Pid ! {self(), Msg}, + receive + done -> ok + after Time -> + saturate(Pid,Time) + end. + +traverse([]) -> ok; +traverse([H|T]) -> + ok = traverse(H), + traverse(T); +traverse(T) when is_tuple(T) -> ok; +traverse(B) when is_binary(B) -> ok; +traverse(I) when is_integer(I) -> ok; +traverse(#{ 1 := V1, b := V2 }) -> + ok = traverse(V1), + ok = traverse(V2), + ok. + + +reloader(Mod,Code,Time) -> + receive + done -> ok + after Time -> + code:purge(Mod), + {module,Mod} = erlang:load_module(Mod, Code), + reloader(Mod,Code,Time) + end. + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> @@ -775,4 +850,7 @@ bit_sized_binary(Bin0) -> BitSize = 8*size(Bin) + 1, Bin. +flush() -> + receive _ -> flush() after 0 -> ok end. + id(I) -> I. diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl index 9802d9d3f9..a36bfe09dd 100644 --- a/erts/emulator/test/code_SUITE_data/literals.erl +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -20,6 +20,7 @@ -module(literals). -export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]). +-export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]). a() -> {a,42.0,[7,38877938333399637266518333334747]}. @@ -101,3 +102,9 @@ unused_binaries() -> bits() -> {bits,<<42:13,?MB_1>>}. + +msg1() -> "halloj". +msg2() -> {"hello","world"}. +msg3() -> <<"halloj">>. +msg4() -> #{ 1=> "hello", b => "world"}. +msg5() -> {1,2,3,4,5,6}. diff --git a/erts/emulator/test/distribution_SUITE_data/run.erl b/erts/emulator/test/distribution_SUITE_data/run.erl index f5169e160c..d5ed139369 100644 --- a/erts/emulator/test/distribution_SUITE_data/run.erl +++ b/erts/emulator/test/distribution_SUITE_data/run.erl @@ -30,16 +30,19 @@ from(H, [_ | T]) -> from(H, T); from(H, []) -> []. start() -> - net_kernel:start([fideridum,shortnames]), - {ok, Node} = slave:start(host(), heppel), - P = spawn(Node, a, b, []), - B1 = term_to_binary(P), - N1 = node(P), - ok = net_kernel:stop(), - N2 = node(P), - io:format("~w~n", [N1 == N2]), + Result = do_it(), + + %% Do GCs and node_and_dist_references + %% in an attempt to crash the VM (without OTP-13076 fix) + lists:foreach(fun(P) -> erlang:garbage_collect(P) end, + processes()), + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:get_internal_state(node_and_dist_references), + + io:format("~w~n", [Result]), + if - N1 == N2 -> + Result -> init:stop(); true -> %% Make sure that the io:format/2 output is really written @@ -47,3 +50,29 @@ start() -> erlang:yield(), init:stop() end. + + +do_it() -> + {ok, _} = net_kernel:start([fideridum,shortnames]), + {ok, Node} = slave:start(host(), heppel), + P = spawn(Node, net_kernel, stop, []), + B1 = term_to_binary(P), + N1 = node(P), + ok = net_kernel:stop(), + N2 = node(P), + + %% OTP-13076 + %% Restart distribution with same node name as previous remote node + %% Repeat to wrap around creation + Result = lists:foldl(fun(_, Acc) -> + timer:sleep(2), % give net_kernel:stop() time to take effect :-( + {ok, _} = net_kernel:start([heppel,shortnames]), + N3 = node(P), + ok = net_kernel:stop(), + N4 = node(P), + Acc and (N3 =:= N1) and (N4 =:= N1) + end, + (N2 =:= N1), + lists:seq(1,3)), + + Result. diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 886ae7d516..6890c42b7a 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -58,6 +58,7 @@ %% erlang t_erlang_hash/1, t_map_encode_decode/1, + t_gc_rare_map_overflow/1, %% non specific BIF related t_bif_build_and_check/1, @@ -121,6 +122,7 @@ all() -> [ %% erlang t_erlang_hash, t_map_encode_decode, + t_gc_rare_map_overflow, t_map_size, t_is_map, %% non specific BIF related @@ -2181,7 +2183,9 @@ t_map_encode_decode(Config) when is_list(Config) -> {<<>>, sc9}, {3.14158, sc10}, {[3.14158], sc11}, {more_atoms, sc12}, {{more_tuples}, sc13}, {self(), sc14}, - {{},{}},{[],[]} + {{},{}},{[],[]}, + {map_s, #{a=>a, 2=>b, 3=>c}}, + {map_l, maps:from_list([{I,I}||I <- lists:seq(1,74)])} ], ok = map_encode_decode_and_match(Pairs,[],#{}), @@ -2245,9 +2249,30 @@ t_map_encode_decode(Config) when is_list(Config) -> %% bad size (too small) .. should fail just truncate it .. weird. %% possibly change external format so truncated will be #{a:=1} - #{ a:=b } = - erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), - + #{ a:=b } = erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + %% specific fannerl (opensource app) binary_to_term error in 18.1 + + #{bias := {1,1,0}, + bit_fail := 0, + connections := #{{2,9} := _, + {8,14} := _, + {2,12} := _, + {5,7} := _, + {11,16} := _, + {11,15} := _}, + layers := {5,7,3}, + network_type := fann_nettype_layer, + num_input := 5, + num_layers := 3, + num_output := 3, + rprop_delta_max := _, + rprop_delta_min := _, + total_connections := 66, + total_neurons := 17, + train_error_function := fann_errorfunc_tanh, + train_stop_function := fann_stopfunc_mse, + training_algorithm := fann_train_rprop} = erlang:binary_to_term(fannerl()), ok. map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> @@ -2966,3 +2991,176 @@ do_badmap_17(Config) -> %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. + + +%% OTP-13146 +%% Provoke major GC with a lot of "fat" maps on external format in msg queue +%% causing heap fragments to be allocated. +t_gc_rare_map_overflow(Config) -> + Pa = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(gc_rare_map_overflow, slave, [{args, "-pa \""++Pa++"\""}]), + Echo = spawn_link(Node, fun Loop() -> receive {From,Msg} -> From ! Msg + end, + Loop() + end), + FatMap = fatmap(34), + false = (flatmap =:= erts_internal:map_type(FatMap)), + + t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end), + + % Repeat test for minor gc: + minor_collect(), % need this to make the next gc really be a minor + t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> true = minor_collect() end), + + unlink(Echo), + test_server:stop_node(Node). + +t_gc_rare_map_overflow_do(Echo, FatMap, GcFun) -> + Master = self(), + true = receive M -> false after 0 -> true end, % assert empty msg queue + Echo ! {Master, token}, + repeat(1000, fun(_) -> Echo ! {Master, FatMap} end, void), + + timer:sleep(100), % Wait for maps to arrive in our msg queue + token = receive Tok -> Tok end, % and provoke move from outer to inner msg queue + + %% Do GC that will "overflow" and create heap frags due to all the fat maps + GcFun(), + + %% Now check that all maps in msg queueu are intact + %% Will crash emulator in OTP-18.1 + repeat(1000, fun(_) -> FatMap = receive FM -> FM end end, void), + ok. + +minor_collect() -> + minor_collect(minor_gcs()). + +minor_collect(Before) -> + After = minor_gcs(), + case After of + _ when After > Before -> true; + _ when After =:= Before -> minor_collect(Before); + 0 -> false + end. + +minor_gcs() -> + {garbage_collection, Info} = process_info(self(), garbage_collection), + {minor_gcs, GCS} = lists:keyfind(minor_gcs, 1, Info), + GCS. + +%% Generate a map with N (or N+1) keys that has an abnormal heap demand. +%% Done by finding keys that collide in the first 32-bit hash. +fatmap(N) -> + erts_debug:set_internal_state(available_internal_state, true), + Table = ets:new(void, [bag, private]), + + Seed0 = rand:seed_s(exsplus, {4711, 3141592, 2718281}), + Seed1 = fatmap_populate(Table, Seed0, (1 bsl 16)), + Keys = fatmap_generate(Table, Seed1, N, []), + ets:delete(Table), + maps:from_list([{K,K} || K <- Keys]). + +fatmap_populate(_, Seed, 0) -> Seed; +fatmap_populate(Table, Seed, N) -> + {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed), + Hash = internal_hash(I), + ets:insert(Table, [{Hash, I}]), + fatmap_populate(Table, NextSeed, N-1). + + +fatmap_generate(_, _, N, Acc) when N =< 0 -> + Acc; +fatmap_generate(Table, Seed, N0, Acc0) -> + {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed), + Hash = internal_hash(I), + case ets:member(Table, Hash) of + true -> + NewKeys = [I | ets:lookup_element(Table, Hash, 2)], + Acc1 = lists:usort(Acc0 ++ NewKeys), + N1 = N0 - (length(Acc1) - length(Acc0)), + fatmap_generate(Table, NextSeed, N1, Acc1); + false -> + fatmap_generate(Table, NextSeed, N0, Acc0) + end. + +internal_hash(Term) -> + erts_debug:get_internal_state({internal_hash, Term}). + + +%% map external_format (fannerl). +fannerl() -> + <<131,116,0,0,0,28,100,0,13,108,101,97,114,110,105,110,103,95,114, + 97,116,101,70,63,230,102,102,96,0,0,0,100,0,17,108,101,97,114,110,105,110, + 103,95,109,111,109,101,110,116,117,109,70,0,0,0,0,0,0,0,0,100,0, + 18,116,114,97,105,110,105,110,103,95,97,108,103,111,114,105,116,104,109,100,0, + 16,102,97,110,110,95,116,114,97,105,110,95,114,112,114,111,112, + 100,0,17,109,101,97,110,95,115,113,117,97,114,101,95,101,114,114,111,114,70, + 0,0,0,0,0,0,0,0,100,0,8,98,105,116,95,102,97,105,108,97,0,100,0,20, + 116,114,97,105,110,95,101,114,114,111,114,95,102,117,110,99,116,105,111, + 110,100,0,19,102,97,110,110,95,101,114,114,111,114,102,117,110,99, + 95,116,97,110,104,100,0,9,110,117,109,95,105,110,112,117,116,97,5,100,0,10,110, + 117,109,95,111,117,116,112,117,116,97,3,100,0,13,116,111,116,97,108, + 95,110,101,117,114,111,110,115,97,17,100,0,17,116,111,116,97,108,95,99,111,110, + 110,101,99,116,105,111,110,115,97,66,100,0,12,110,101,116,119,111,114,107, + 95,116,121,112,101,100,0,18,102,97,110,110,95,110,101,116,116,121,112,101, + 95,108,97,121,101,114,100,0,15,99,111,110,110,101,99,116,105,111,110,95, + 114,97,116,101,70,63,240,0,0,0,0,0,0,100,0,10,110,117,109,95,108,97,121,101, + 114,115,97,3,100,0,19,116,114,97,105,110,95,115,116,111,112,95,102,117,110, + 99,116,105,111,110,100,0,17,102,97,110,110,95,115,116,111,112,102,117,110, + 99,95,109,115,101,100,0,15,113,117,105,99,107,112,114,111,112,95,100,101,99, + 97,121,70,191,26,54,226,224,0,0,0,100,0,12,113,117,105,99,107,112,114, + 111,112,95,109,117,70,63,252,0,0,0,0,0,0,100,0,21,114,112,114,111,112,95,105, + 110,99,114,101,97,115,101,95,102,97,99,116,111,114,70,63,243,51,51, + 64,0,0,0,100,0,21,114,112,114,111,112,95,100,101,99,114,101,97,115,101, + 95,102,97,99,116,111,114,70,63,224,0,0,0,0,0,0,100,0,15,114,112,114,111,112, + 95,100,101,108,116,97,95,109,105,110,70,0,0,0,0,0,0,0,0,100,0,15,114,112,114, + 111,112,95,100,101,108,116,97,95,109,97,120,70,64,73,0,0,0,0,0,0,100,0, + 16,114,112,114,111,112,95,100,101,108,116,97,95,122,101,114,111,70,63,185,153, + 153,160,0,0,0,100,0,26,115,97,114,112,114,111,112,95,119,101,105,103, + 104,116,95,100,101,99,97,121,95,115,104,105,102,116,70,192,26,147,116,192,0,0,0, + 100,0,35,115,97,114,112,114,111,112,95,115,116,101,112,95,101,114, + 114,111,114,95,116,104,114,101,115,104,111,108,100,95,102,97,99,116,111,114,70, + 63,185,153,153,160,0,0,0,100,0,24,115,97,114,112,114,111,112,95,115, + 116,101,112,95,101,114,114,111,114,95,115,104,105,102,116,70,63,246,40,245, + 192,0,0,0,100,0,19,115,97,114,112,114,111,112,95,116,101,109,112,101,114, + 97,116,117,114,101,70,63,142,184,81,224,0,0,0,100,0,6,108,97,121,101,114,115, + 104,3,97,5,97,7,97,3,100,0,4,98,105,97,115,104,3,97,1,97,1,97,0,100,0,11, + 99,111,110,110,101,99,116,105,111,110,115,116,0,0,0,66,104,2,97,0,97,6,70, + 191,179,51,44,64,0,0,0,104,2,97,1,97,6,70,63,178,130,90,32,0,0,0,104,2,97,2, + 97,6,70,63,82,90,88,0,0,0,0,104,2,97,3,97,6,70,63,162,91,63,192,0,0,0,104,2, + 97,4,97,6,70,191,151,70,169,0,0,0,0,104,2,97,5,97,6,70,191,117,52,222,0,0,0, + 0,104,2,97,0,97,7,70,63,152,240,139,0,0,0,0,104,2,97,1,97,7,70,191,166,31, + 187,160,0,0,0,104,2,97,2,97,7,70,191,150,70,63,0,0,0,0,104,2,97,3,97,7,70, + 63,152,181,126,128,0,0,0,104,2,97,4,97,7,70,63,151,187,162,128,0,0,0,104,2, + 97,5,97,7,70,191,143,161,101,0,0,0,0,104,2,97,0,97,8,70,191,153,102,36,128,0, + 0,0,104,2,97,1,97,8,70,63,160,139,250,64,0,0,0,104,2,97,2,97,8,70,63,164,62, + 196,64,0,0,0,104,2,97,3,97,8,70,191,178,78,209,192,0,0,0,104,2,97,4,97,8,70, + 191,185,19,76,224,0,0,0,104,2,97,5,97,8,70,63,183,142,196,96,0,0,0,104,2,97,0, + 97,9,70,63,150,104,248,0,0,0,0,104,2,97,1,97,9,70,191,164,4,100,224,0,0,0, + 104,2,97,2,97,9,70,191,169,42,42,224,0,0,0,104,2,97,3,97,9,70,63,145,54,78,128,0, + 0,0,104,2,97,4,97,9,70,63,126,243,134,0,0,0,0,104,2,97,5,97,9,70,63,177, + 203,25,96,0,0,0,104,2,97,0,97,10,70,63,172,104,47,64,0,0,0,104,2,97,1,97,10, + 70,63,161,242,193,64,0,0,0,104,2,97,2,97,10,70,63,175,208,241,192,0,0,0,104,2, + 97,3,97,10,70,191,129,202,161,0,0,0,0,104,2,97,4,97,10,70,63,178,151,55,32,0,0,0, + 104,2,97,5,97,10,70,63,137,155,94,0,0,0,0,104,2,97,0,97,11,70,191,179, + 106,160,0,0,0,0,104,2,97,1,97,11,70,63,184,253,164,96,0,0,0,104,2,97,2,97,11, + 70,191,143,30,157,0,0,0,0,104,2,97,3,97,11,70,63,153,225,140,128,0,0,0,104, + 2,97,4,97,11,70,63,161,35,85,192,0,0,0,104,2,97,5,97,11,70,63,175,200,55,192, + 0,0,0,104,2,97,0,97,12,70,191,180,116,132,96,0,0,0,104,2,97,1,97,12,70,191, + 165,151,152,0,0,0,0,104,2,97,2,97,12,70,191,180,197,91,160,0,0,0,104,2,97,3,97,12, + 70,191,91,30,160,0,0,0,0,104,2,97,4,97,12,70,63,180,251,45,32,0,0,0, + 104,2,97,5,97,12,70,63,165,134,77,64,0,0,0,104,2,97,6,97,14,70,63,181,56,242,96, + 0,0,0,104,2,97,7,97,14,70,191,165,239,234,224,0,0,0,104,2,97,8,97,14, + 70,191,154,65,216,128,0,0,0,104,2,97,9,97,14,70,63,150,250,236,0,0,0,0,104,2,97, + 10,97,14,70,191,141,105,108,0,0,0,0,104,2,97,11,97,14,70,191,152,40, + 165,0,0,0,0,104,2,97,12,97,14,70,63,141,159,46,0,0,0,0,104,2,97,13,97,14,70, + 191,183,172,137,32,0,0,0,104,2,97,6,97,15,70,63,163,26,123,192,0,0,0,104, + 2,97,7,97,15,70,63,176,184,106,32,0,0,0,104,2,97,8,97,15,70,63,152,234,144, + 0,0,0,0,104,2,97,9,97,15,70,191,172,58,70,160,0,0,0,104,2,97,10,97,15,70, + 63,161,211,211,192,0,0,0,104,2,97,11,97,15,70,191,148,171,120,128,0,0,0,104, + 2,97,12,97,15,70,63,180,117,214,224,0,0,0,104,2,97,13,97,15,70,191,104, + 230,216,0,0,0,0,104,2,97,6,97,16,70,63,178,53,103,96,0,0,0,104,2,97,7,97,16, + 70,63,170,230,232,64,0,0,0,104,2,97,8,97,16,70,191,183,45,100,192,0,0,0, + 104,2,97,9,97,16,70,63,184,100,97,32,0,0,0,104,2,97,10,97,16,70,63,169,174, + 254,64,0,0,0,104,2,97,11,97,16,70,191,119,121,234,0,0,0,0,104,2,97,12,97, + 16,70,63,149,12,170,128,0,0,0,104,2,97,13,97,16,70,191,144,193,191,0,0,0,0>>. diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c index 9c78c0e04d..f7e729e2b6 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -240,7 +240,7 @@ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ADD_CALL("get_priv_data_ptr"); - return enif_make_ulong(env, (unsigned long)priv_data(env)); + return enif_make_uint64(env, (ErlNifUInt64)priv_data(env)); } static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) |