diff options
Diffstat (limited to 'erts/emulator')
38 files changed, 1117 insertions, 1162 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index e0260205e3..21bcbbab27 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -51,7 +51,6 @@ ARFLAGS=rc OMIT_OMIT_FP=no DIRTY_SCHEDULER_SUPPORT=@DIRTY_SCHEDULER_SUPPORT@ -NEW_PURGE_STRATEGY=@NEW_PURGE_STRATEGY@ ifeq ($(TYPE),debug) PURIFY = @@ -563,9 +562,9 @@ $(TARGET)/erl_bif_table.c \ $(TARGET)/erl_bif_table.h \ $(TARGET)/erl_bif_wrap.c \ $(TARGET)/erl_bif_list.h \ +$(TARGET)/erl_gc_bifs.c \ $(TARGET)/erl_atom_table.c \ $(TARGET)/erl_atom_table.h \ -$(TARGET)/erl_pbifs.c \ : $(TARGET)/TABLES-GENERATED $(TARGET)/TABLES-GENERATED: $(ATOMS) $(BIFS) utils/make_tables $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ @@ -739,7 +738,6 @@ EMU_OBJS = \ $(OBJDIR)/beam_ranges.o RUN_OBJS = \ - $(OBJDIR)/erl_pbifs.o \ $(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \ $(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \ $(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \ @@ -750,6 +748,7 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \ $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_unique.o \ $(OBJDIR)/erl_bif_wrap.o \ + $(OBJDIR)/erl_gc_bifs.o \ $(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \ $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 2b66bf6f4e..66af05c1f2 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -366,6 +366,7 @@ atom long_schedule atom low atom Lt='<' atom machine +atom major atom match atom match_limit atom match_limit_recursion @@ -395,6 +396,7 @@ atom milli_seconds atom millisecond atom min_heap_size atom min_bin_vheap_size +atom minor atom minor_version atom Minus='-' atom module diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 5969197168..153fa205ed 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -65,7 +65,6 @@ erts_smp_atomic_t erts_copy_literal_area__; #define ERTS_SET_COPY_LITERAL_AREA(LA) \ erts_smp_atomic_set_nob(&erts_copy_literal_area__, \ (erts_aint_t) (LA)) -#ifdef ERTS_NEW_PURGE_STRATEGY Process *erts_literal_area_collector = NULL; typedef struct ErtsLiteralAreaRef_ ErtsLiteralAreaRef; @@ -79,10 +78,9 @@ struct { ErtsLiteralAreaRef *first; ErtsLiteralAreaRef *last; } release_literal_areas; -#endif static void set_default_trace_pattern(Eterm module); -static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls); +static Eterm check_process_code(Process* rp, Module* modp, int *redsp, int fcalls); static void delete_code(Module* modp); static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); @@ -113,11 +111,9 @@ init_purge_state(void) void erts_beam_bif_load_init(void) { -#ifdef ERTS_NEW_PURGE_STRATEGY erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas"); release_literal_areas.first = NULL; release_literal_areas.last = NULL; -#endif erts_smp_atomic_init_nob(&erts_copy_literal_area__, (erts_aint_t) NULL); @@ -547,7 +543,7 @@ check_old_code_1(BIF_ALIST_1) } Eterm -erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls) +erts_check_process_code(Process *c_p, Eterm module, int *redsp, int fcalls) { Module* modp; Eterm res; @@ -562,31 +558,23 @@ erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int if (!modp) return am_false; erts_rlock_old_code(code_ix); - res = (!modp->old.code_hdr ? am_false : - check_process_code(c_p, modp, flags, redsp, fcalls)); + res = (!modp->old.code_hdr + ? am_false + : check_process_code(c_p, modp, redsp, fcalls)); erts_runlock_old_code(code_ix); return res; } -BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) +BIF_RETTYPE erts_internal_check_process_code_1(BIF_ALIST_1) { int reds = 0; - Uint flags; Eterm res; if (is_not_atom(BIF_ARG_1)) goto badarg; - if (is_not_small(BIF_ARG_2)) - goto badarg; - - flags = unsigned_val(BIF_ARG_2); - if (flags & ~ERTS_CPC_ALL) { - goto badarg; - } - - res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds, BIF_P->fcalls); + res = erts_check_process_code(BIF_P, BIF_ARG_1, &reds, BIF_P->fcalls); ASSERT(is_value(res)); @@ -622,7 +610,7 @@ BIF_RETTYPE erts_internal_check_dirty_process_code_2(BIF_ALIST_2) if (!rp) BIF_RET(am_false); - res = erts_check_process_code(rp, BIF_ARG_2, 0, &reds, BIF_P->fcalls); + res = erts_check_process_code(rp, BIF_ARG_2, &reds, BIF_P->fcalls); if (BIF_P != rp) erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); @@ -871,32 +859,12 @@ set_default_trace_pattern(Eterm module) } } -#ifndef ERTS_NEW_PURGE_STRATEGY - -static ERTS_INLINE int -check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) -{ - struct erl_off_heap_header* oh; - for (oh = off_heap->first; oh; oh = oh->next) { - if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { - ErlFunThing* funp = (ErlFunThing*) oh; - if (ErtsInArea(funp->fe->address, area, area_size)) - return !0; - } - } - return 0; -} - -#endif - static Uint hfrag_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size); static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp, Eterm *start, Eterm *end, char *lit_start, Uint lit_size); -#ifdef ERTS_NEW_PURGE_STRATEGY - Eterm erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed) { @@ -1063,7 +1031,7 @@ literal_gc: } static Eterm -check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls) +check_process_code(Process* rp, Module* modp, int *redsp, int fcalls) { BeamInstr* start; char* mod_start; @@ -1128,253 +1096,6 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls return am_false; } -#else /* !ERTS_NEW_PURGE_STRATEGY, i.e, old style purge... */ - -static Eterm -check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls) -{ - BeamInstr* start; - char* literals; - Uint lit_bsize; - char* mod_start; - Uint mod_size; - Eterm* sp; - int done_gc = 0; - int need_gc = 0; - ErtsMessage *msgp; - ErlHeapFragment *hfrag; - -#define ERTS_ORDINARY_GC__ (1 << 0) -#define ERTS_LITERAL_GC__ (1 << 1) - - /* - * Pick up limits for the module. - */ - start = (BeamInstr*) modp->old.code_hdr; - mod_start = (char *) start; - mod_size = modp->old.code_length; - - /* - * Check if current instruction or continuation pointer points into module. - */ - if (ErtsInArea(rp->i, mod_start, mod_size) - || ErtsInArea(rp->cp, mod_start, mod_size)) { - return am_true; - } - - /* - * Check all continuation pointers stored on the stack. - */ - for (sp = rp->stop; sp < STACK_START(rp); sp++) { - if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) { - return am_true; - } - } - - /* - * Check all continuation pointers stored in stackdump - * and clear exception stackdump if there is a pointer - * to the module. - */ - if (rp->ftrace != NIL) { - struct StackTrace *s; - ASSERT(is_list(rp->ftrace)); - s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace))); - if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) || - (s->current && ErtsInArea(s->current, mod_start, mod_size))) { - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - } else { - int i; - for (i = 0; i < s->depth; i++) { - if (ErtsInArea(s->trace[i], mod_start, mod_size)) { - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - break; - } - } - } - } - - if (rp->flags & F_DISABLE_GC) { - /* - * Cannot proceed. Process has disabled gc in order to - * safely leave inconsistent data on the heap and/or - * off heap lists. Need to wait for gc to be enabled - * again. - */ - return THE_NON_VALUE; - } - - /* - * Message queue can contains funs, and may contain - * literals. If we got references to this module from the message - * queue. - * - * If a literal is in the message queue we maka an explicit copy of - * and attach it to the heap fragment. Each message needs to be - * self contained, we cannot save the literal in the old_heap or - * any other heap than the message it self. - */ - - erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ); - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); - - if (modp->old.code_hdr->literal_area) { - literals = (char*) modp->old.code_hdr->literal_area->start; - lit_bsize = (char*) modp->old.code_hdr->literal_area->end - literals; - } - else { - literals = NULL; - lit_bsize = 0; - } - - for (msgp = rp->msg.first; msgp; msgp = msgp->next) { - if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) - hfrag = &msgp->hfrag; - else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag) - hfrag = msgp->data.heap_frag; - else - continue; - { - ErlHeapFragment *hf; - Uint lit_sz; - for (hf=hfrag; hf; hf = hf->next) { - if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) - return am_true; - lit_sz = hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size], - literals, lit_bsize); - } - if (lit_sz > 0) { - ErlHeapFragment *bp = new_message_buffer(lit_sz); - Eterm *hp = bp->mem; - - for (hf=hfrag; hf; hf = hf->next) { - hfrag_literal_copy(&hp, &bp->off_heap, - &hf->mem[0], &hf->mem[hf->used_size], - literals, lit_bsize); - hfrag=hf; - } - /* link new hfrag last */ - ASSERT(hfrag->next == NULL); - hfrag->next = bp; - bp->next = NULL; - } - } - } - - while (1) { - - /* Check heap, stack etc... */ - if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size)) - goto try_gc; - if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) { - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - } - if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize)) - goto try_literal_gc; -#ifdef HIPE - if (nstack_any_heap_ref_ptrs(rp, literals, lit_bsize)) - goto try_literal_gc; -#endif - if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize)) - goto try_literal_gc; - if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize)) - goto try_literal_gc; - - /* Check dictionary */ - if (rp->dictionary) { - Eterm* start = ERTS_PD_START(rp->dictionary); - Eterm* end = start + ERTS_PD_SIZE(rp->dictionary); - - if (any_heap_ref_ptrs(start, end, literals, lit_bsize)) - goto try_literal_gc; - } - - /* Check heap fragments */ - for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) { - Eterm *hp, *hp_end; - /* Off heap lists should already have been moved into process */ - ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); - - hp = &hfrag->mem[0]; - hp_end = &hfrag->mem[hfrag->used_size]; - if (any_heap_refs(hp, hp_end, literals, lit_bsize)) - goto try_literal_gc; - } - - /* - * Message buffer fragments (matched messages) - * - off heap lists should already have been moved into - * process off heap structure. - * - Check for literals - */ - for (msgp = rp->msg_frag; msgp; msgp = msgp->next) { - hfrag = erts_message_to_heap_frag(msgp); - for (; hfrag; hfrag = hfrag->next) { - Eterm *hp, *hp_end; - ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)); - - hp = &hfrag->mem[0]; - hp_end = &hfrag->mem[hfrag->used_size]; - - if (any_heap_refs(hp, hp_end, literals, lit_bsize)) - goto try_literal_gc; - } - } - - return am_false; - - try_literal_gc: - need_gc |= ERTS_LITERAL_GC__; - - try_gc: - need_gc |= ERTS_ORDINARY_GC__; - - if ((done_gc & need_gc) == need_gc) - return am_true; - - if (!(flags & ERTS_CPC_ALLOW_GC)) - return am_aborted; - - need_gc &= ~done_gc; - - /* - * Try to get rid of literals by by garbage collecting. - * Clear both fvalue and ftrace. - */ - - rp->freason = EXC_NULL; - rp->fvalue = NIL; - rp->ftrace = NIL; - - if (need_gc & ERTS_ORDINARY_GC__) { - FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls); - done_gc |= ERTS_ORDINARY_GC__; - } - if (need_gc & ERTS_LITERAL_GC__) { - struct erl_off_heap_header* oh; - oh = modp->old.code_hdr->literal_area->off_heap; - *redsp += lit_bsize / 64; /* Need, better value... */ - erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh); - done_gc |= ERTS_LITERAL_GC__; - } - need_gc = 0; - } - -#undef ERTS_ORDINARY_GC__ -#undef ERTS_LITERAL_GC__ - -} - -#endif /* !ERTS_NEW_PURGE_STRATEGY */ - static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) { @@ -1503,8 +1224,6 @@ hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp, } } -#ifdef ERTS_NEW_PURGE_STRATEGY - #ifdef ERTS_SMP ErtsThrPrgrLaterOp later_literal_area_switch; @@ -1535,13 +1254,8 @@ complete_literal_area_switch(void *literal_area) } #endif -#endif /* ERTS_NEW_PURGE_STRATEGY */ - BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0) { -#ifndef ERTS_NEW_PURGE_STRATEGY - BIF_ERROR(BIF_P, EXC_NOTSUP); -#else ErtsLiteralArea *unused_la; ErtsLiteralAreaRef *la_ref; @@ -1600,7 +1314,6 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0) BIF_RET(am_true); #endif -#endif /* ERTS_NEW_PURGE_STRATEGY */ } void @@ -1794,10 +1507,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2) code = (BeamInstr*) modp->old.code_hdr; end = (BeamInstr *)((char *)code + modp->old.code_length); erts_fun_purge_prepare(code, end); -#if !defined(ERTS_NEW_PURGE_STRATEGY) - ASSERT(!ERTS_COPY_LITERAL_AREA()); - ERTS_SET_COPY_LITERAL_AREA(modp->old.code_hdr->literal_area); -#endif } if (BIF_ARG_2 == am_prepare_on_load) { @@ -1842,10 +1551,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2) erts_fun_purge_abort_prepare(purge_state.funs, purge_state.fe_ix); -#if !defined(ERTS_NEW_PURGE_STRATEGY) - ASSERT(ERTS_COPY_LITERAL_AREA()); - ERTS_SET_COPY_LITERAL_AREA(NULL); -#endif #ifndef ERTS_SMP erts_fun_purge_abort_finalize(purge_state.funs, purge_state.fe_ix); finalize_purge_operation(BIF_P, 0); @@ -1960,14 +1665,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2) finalize_purge_operation(BIF_P, ret == am_true); -#if !defined(ERTS_NEW_PURGE_STRATEGY) - - ASSERT(ERTS_COPY_LITERAL_AREA() == literals); - ERTS_SET_COPY_LITERAL_AREA(NULL); - erts_release_literal_area(literals); - -#else /* ERTS_NEW_PURGE_STRATEGY */ - if (literals) { ErtsLiteralAreaRef *ref; ref = erts_alloc(ERTS_ALC_T_LITERAL_REF, @@ -1991,8 +1688,6 @@ BIF_RETTYPE erts_internal_purge_module_2(BIF_ALIST_2) BIF_P->common.id); } -#endif /* ERTS_NEW_PURGE_STRATEGY */ - return ret; } diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index a4ad3e7886..8f47ed4d9d 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -51,6 +51,7 @@ void dbg_bt(Process* p, Eterm* sp); void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg); static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr); +static void print_bif_name(int to, void* to_arg, BifFunction bif); BIF_RETTYPE erts_debug_same_2(BIF_ALIST_2) @@ -520,7 +521,27 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) break; case 'I': /* Untagged integer. */ case 't': - erts_print(to, to_arg, "%d", *ap); + switch (op) { + case op_i_gc_bif1_jIsId: + case op_i_gc_bif2_jIIssd: + case op_i_gc_bif3_jIIssd: + { + const ErtsGcBif* p; + BifFunction gcf = (BifFunction) *ap; + for (p = erts_gc_bifs; p->bif != 0; p++) { + if (p->gc_bif == gcf) { + print_bif_name(to, to_arg, p->bif); + break; + } + } + if (p->bif == 0) { + erts_print(to, to_arg, "%d", (Uint)gcf); + } + break; + } + default: + erts_print(to, to_arg, "%d", *ap); + } ap++; break; case 'f': /* Destination label */ @@ -560,19 +581,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) case 'F': /* Function definition */ break; case 'b': - for (i = 0; i < BIF_SIZE; i++) { - BifFunction bif = (BifFunction) *ap; - if (bif == bif_table[i].f) { - break; - } - } - if (i == BIF_SIZE) { - erts_print(to, to_arg, "b(%d)", (Uint) *ap); - } else { - Eterm name = bif_table[i].name; - unsigned arity = bif_table[i].arity; - erts_print(to, to_arg, "%T/%u", name, arity); - } + print_bif_name(to, to_arg, (BifFunction) *ap); ap++; break; case 'P': /* Byte offset into tuple (see beam_load.c) */ @@ -731,3 +740,21 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) return size; } + +static void print_bif_name(int to, void* to_arg, BifFunction bif) +{ + int i; + + for (i = 0; i < BIF_SIZE; i++) { + if (bif == bif_table[i].f) { + break; + } + } + if (i == BIF_SIZE) { + erts_print(to, to_arg, "b(%d)", (Uint) bif); + } else { + Eterm name = bif_table[i].name; + unsigned arity = bif_table[i].arity; + erts_print(to, to_arg, "%T/%u", name, arity); + } +} diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index ef4cdf9d5a..0ba06058a5 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1078,7 +1078,7 @@ static Eterm make_arglist(Process* c_p, Eterm* reg, int a); void init_emulator(void) { - process_main(); + process_main(0, 0); } /* @@ -1225,7 +1225,7 @@ init_emulator(void) * the instructions' C labels to the loader. * The second call starts execution of BEAM code. This call never returns. */ -void process_main(void) +void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) { static int init_done = 0; Process* c_p = NULL; @@ -1237,7 +1237,7 @@ void process_main(void) /* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC, * in all other cases x0 is used. */ - register Eterm* reg REG_xregs = NULL; + register Eterm* reg REG_xregs = x_reg_array; /* * Top of heap (next free location); grows upwards. @@ -1264,7 +1264,7 @@ void process_main(void) * X registers and floating point registers are located in * scheduler specific data. */ - register FloatDef *freg; + register FloatDef *freg = f_reg_array; /* * For keeping the negative old value of 'reds' when call saving is active. @@ -1350,8 +1350,6 @@ void process_main(void) start_time_i = c_p->i; } - reg = erts_proc_sched_data(c_p)->x_reg_array; - freg = erts_proc_sched_data(c_p)->f_reg_array; ERL_BITS_RELOAD_STATEP(c_p); { int reds; @@ -5437,31 +5435,14 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) static BifFunction translate_gc_bif(void* gcf) { - if (gcf == erts_gc_length_1) { - return length_1; - } else if (gcf == erts_gc_size_1) { - return size_1; - } else if (gcf == erts_gc_bit_size_1) { - return bit_size_1; - } else if (gcf == erts_gc_byte_size_1) { - return byte_size_1; - } else if (gcf == erts_gc_map_size_1) { - return map_size_1; - } else if (gcf == erts_gc_abs_1) { - return abs_1; - } else if (gcf == erts_gc_float_1) { - return float_1; - } else if (gcf == erts_gc_round_1) { - return round_1; - } else if (gcf == erts_gc_trunc_1) { - return round_1; - } else if (gcf == erts_gc_binary_part_2) { - return binary_part_2; - } else if (gcf == erts_gc_binary_part_3) { - return binary_part_3; - } else { - erts_exit(ERTS_ERROR_EXIT, "bad gc bif"); + const ErtsGcBif* p; + + for (p = erts_gc_bifs; p->bif != 0; p++) { + if (p->gc_bif == gcf) { + return p->bif; + } } + erts_exit(ERTS_ERROR_EXIT, "bad gc bif"); } /* diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 0afdedf6c2..d69b18e22f 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4031,60 +4031,52 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) op->next = NULL; return op; } + +static GenOp* +translate_gc_bif(LoaderState* stp, GenOp* op, GenOpArg Bif) +{ + const ErtsGcBif* p; + BifFunction bf; + + bf = stp->import[Bif.val].bf; + for (p = erts_gc_bifs; p->bif != 0; p++) { + if (p->bif == bf) { + op->a[1].type = TAG_u; + op->a[1].val = (BeamInstr) p->gc_bif; + return op; + } + } + + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; +} + /* - * Rewrite gc_bifs with one parameter (the common case). Utilized - * in ops.tab to rewrite instructions calling bif's in guards - * to use a garbage collecting implementation. + * Rewrite gc_bifs with one parameter (the common case). */ static GenOp* gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg Src, GenOpArg Dst) { GenOp* op; - BifFunction bf; NEW_GENOP(stp, op); op->next = NULL; - bf = stp->import[Bif.val].bf; - /* The translations here need to have a reverse counterpart in - beam_emu.c:translate_gc_bif for error handling to work properly. */ - if (bf == length_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_length_1; - } else if (bf == size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_size_1; - } else if (bf == bit_size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_bit_size_1; - } else if (bf == byte_size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_byte_size_1; - } else if (bf == map_size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_map_size_1; - } else if (bf == abs_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_abs_1; - } else if (bf == float_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_float_1; - } else if (bf == round_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_round_1; - } else if (bf == trunc_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1; - } else { - op->op = genop_unsupported_guard_bif_3; - op->arity = 3; - op->a[0].type = TAG_a; - op->a[0].val = stp->import[Bif.val].module; - op->a[1].type = TAG_a; - op->a[1].val = stp->import[Bif.val].function; - op->a[2].type = TAG_u; - op->a[2].val = stp->import[Bif.val].arity; - return op; - } op->op = genop_i_gc_bif1_5; op->arity = 5; op->a[0] = Fail; - op->a[1].type = TAG_u; + /* op->a[1] is set by translate_gc_bif() */ op->a[2] = Src; op->a[3] = Live; op->a[4] = Dst; - return op; + return translate_gc_bif(stp, op, Bif); } /* @@ -4095,35 +4087,18 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg S1, GenOpArg S2, GenOpArg Dst) { GenOp* op; - BifFunction bf; NEW_GENOP(stp, op); op->next = NULL; - bf = stp->import[Bif.val].bf; - /* The translations here need to have a reverse counterpart in - beam_emu.c:translate_gc_bif for error handling to work properly. */ - if (bf == binary_part_2) { - op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2; - } else { - op->op = genop_unsupported_guard_bif_3; - op->arity = 3; - op->a[0].type = TAG_a; - op->a[0].val = stp->import[Bif.val].module; - op->a[1].type = TAG_a; - op->a[1].val = stp->import[Bif.val].function; - op->a[2].type = TAG_u; - op->a[2].val = stp->import[Bif.val].arity; - return op; - } op->op = genop_i_gc_bif2_6; op->arity = 6; op->a[0] = Fail; - op->a[1].type = TAG_u; + /* op->a[1] is set by translate_gc_bif() */ op->a[2] = Live; op->a[3] = S1; op->a[4] = S2; op->a[5] = Dst; - return op; + return translate_gc_bif(stp, op, Bif); } /* @@ -4134,37 +4109,19 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg S1, GenOpArg S2, GenOpArg S3, GenOpArg Dst) { GenOp* op; - BifFunction bf; NEW_GENOP(stp, op); op->next = NULL; - bf = stp->import[Bif.val].bf; - /* The translations here need to have a reverse counterpart in - beam_emu.c:translate_gc_bif for error handling to work properly. */ - if (bf == binary_part_3) { - op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3; - } else { - op->op = genop_unsupported_guard_bif_3; - op->arity = 3; - op->a[0].type = TAG_a; - op->a[0].val = stp->import[Bif.val].module; - op->a[1].type = TAG_a; - op->a[1].val = stp->import[Bif.val].function; - op->a[2].type = TAG_u; - op->a[2].val = stp->import[Bif.val].arity; - return op; - } op->op = genop_ii_gc_bif3_7; op->arity = 7; op->a[0] = Fail; - op->a[1].type = TAG_u; + /* op->a[1] is set by translate_gc_bif() */ op->a[2] = Live; op->a[3] = S1; op->a[4] = S2; op->a[5] = S3; op->a[6] = Dst; - op->next = NULL; - return op; + return translate_gc_bif(stp, op, Bif); } static GenOp* @@ -4882,7 +4839,7 @@ transform_engine(LoaderState* st) { Uint op; int ap; /* Current argument. */ - Uint* restart; /* Where to restart if current match fails. */ + const Uint* restart; /* Where to restart if current match fails. */ GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ GenOpArg* rest_args = NULL; int num_rest_args = 0; @@ -4891,7 +4848,7 @@ transform_engine(LoaderState* st) GenOp* instr; GenOp* first = st->genop; GenOp* keep = NULL; - Uint* pc; + const Uint* pc; static Uint restart_fail[1] = {TOP_fail}; ASSERT(gen_opc[first->op].transform != -1); diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index 1200bb9c6f..6be4031822 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -35,7 +35,7 @@ typedef struct gen_op_entry { int transform; } GenOpEntry; -extern GenOpEntry gen_opc[]; +extern const GenOpEntry gen_opc[]; #ifdef NO_JUMP_TABLE #define BeamOp(Op) (Op) diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d9048065c8..84eab5f651 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -3869,7 +3869,24 @@ BIF_RETTYPE garbage_collect_0(BIF_ALIST_0) { FLAGS(BIF_P) |= F_NEED_FULLSWEEP; erts_garbage_collect(BIF_P, 0, NULL, 0); - BIF_RET(am_true); + return am_true; +} + +/* + * Pass atom 'minor' for relaxed generational GC run. This is only + * recommendation, major run may still be chosen by VM. + * Pass atom 'major' for default behaviour - major GC run (fullsweep) + */ +BIF_RETTYPE +erts_internal_garbage_collect_1(BIF_ALIST_1) +{ + switch (BIF_ARG_1) { + case am_minor: break; + case am_major: FLAGS(BIF_P) |= F_NEED_FULLSWEEP; break; + default: BIF_ERROR(BIF_P, BADARG); + } + erts_garbage_collect(BIF_P, 0, NULL, 0); + return am_true; } /**********************************************************************/ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 80db4eb6ff..852b1135fe 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -23,22 +23,24 @@ # # Lines starting with '#' are ignored. # -# <bif-decl> ::= "bif" <bif> <C-name>* | "ubif" <bif> <C-name>* +# <bif-decl> ::= "bif" <bif> <C-name>* | +# "ubif" <bif> <C-name>* | +# "gcbif" <bif> <C-name>* # <bif> ::= <module> ":" <name> "/" <arity> # -# "ubif" is an unwrapped bif, i.e. a bif without a trace wrapper, -# or rather; the trace entry point in the export entry is the same -# as the normal entry point, and no trace wrapper is generated. +# ubif: Use for operators and guard BIFs that never build anything +# on the heap (such as tuple_size/1) and operators. # -# Important: Use "ubif" for guard BIFs and operators; use "bif" for ordinary BIFs. +# gcbif: Use for guard BIFs that may build on the heap (such as abs/1). +# +# bif: Use for all other BIFs. # # Add new BIFs to the end of the file. # -# Note: Guards BIFs require special support in the compiler (to be able to actually -# call them from within a guard). +# Note: Guards BIFs usually require special support in the compiler. # -ubif erlang:abs/1 +gcbif erlang:abs/1 bif erlang:adler32/1 bif erlang:adler32/2 bif erlang:adler32_combine/3 @@ -62,11 +64,12 @@ bif erlang:exit/1 bif erlang:exit/2 bif erlang:external_size/1 bif erlang:external_size/2 -ubif erlang:float/1 +gcbif erlang:float/1 bif erlang:float_to_list/1 bif erlang:float_to_list/2 bif erlang:fun_info/2 bif erlang:garbage_collect/0 +bif erts_internal:garbage_collect/1 bif erlang:get/0 bif erlang:get/1 bif erlang:get_keys/1 @@ -79,7 +82,7 @@ bif erlang:phash2/2 ubif erlang:hd/1 bif erlang:integer_to_list/1 bif erlang:is_alive/0 -ubif erlang:length/1 +gcbif erlang:length/1 bif erlang:link/1 bif erlang:list_to_atom/1 bif erlang:list_to_binary/1 @@ -126,10 +129,10 @@ bif erlang:processes/0 bif erlang:put/2 bif erlang:register/2 bif erlang:registered/0 -ubif erlang:round/1 +gcbif erlang:round/1 ubif erlang:self/0 bif erlang:setelement/3 -ubif erlang:size/1 +gcbif erlang:size/1 bif erlang:spawn/3 bif erlang:spawn_link/3 bif erlang:split_binary/2 @@ -139,7 +142,7 @@ bif erlang:term_to_binary/2 bif erlang:throw/1 bif erlang:time/0 ubif erlang:tl/1 -ubif erlang:trunc/1 +gcbif erlang:trunc/1 bif erlang:tuple_to_list/1 bif erlang:universaltime/0 bif erlang:universaltime_to_localtime/1 @@ -162,7 +165,7 @@ bif erts_internal:port_connect/2 bif erts_internal:request_system_task/3 bif erts_internal:request_system_task/4 -bif erts_internal:check_process_code/2 +bif erts_internal:check_process_code/1 bif erts_internal:map_to_tuple_keys/1 bif erts_internal:term_type/1 @@ -464,8 +467,8 @@ bif erlang:list_to_existing_atom/1 # ubif erlang:is_bitstring/1 ubif erlang:tuple_size/1 -ubif erlang:byte_size/1 -ubif erlang:bit_size/1 +gcbif erlang:byte_size/1 +gcbif erlang:bit_size/1 bif erlang:list_to_bitstring/1 bif erlang:bitstring_to_list/1 @@ -517,8 +520,8 @@ bif erlang:binary_to_term/2 # # The searching/splitting/substituting thingies # -ubif erlang:binary_part/2 -ubif erlang:binary_part/3 +gcbif erlang:binary_part/2 +gcbif erlang:binary_part/3 bif binary:compile_pattern/1 bif binary:match/2 @@ -610,7 +613,7 @@ bif os:unsetenv/1 bif re:inspect/2 ubif erlang:is_map/1 -ubif erlang:map_size/1 +gcbif erlang:map_size/1 bif maps:to_list/1 bif maps:find/2 bif maps:get/2 @@ -657,6 +660,15 @@ bif erlang:has_prepared_code_on_load/1 bif maps:take/2 # +# New in 20.0 +# + +gcbif erlang:floor/1 +gcbif erlang:ceil/1 +bif math:floor/1 +bif math:ceil/1 + +# # Obsolete # diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index ccc4cbad43..c4dcd6a3cc 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -40,7 +40,8 @@ static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*, int); /* * Copy object "obj" to process p. */ -Eterm copy_object_x(Eterm obj, Process* to, Uint extra) { +Eterm copy_object_x(Eterm obj, Process* to, Uint extra) +{ if (!is_immed(obj)) { Uint size = size_object(obj); Eterm* hp = HAllocX(to, size, extra); @@ -70,33 +71,46 @@ Eterm copy_object_x(Eterm obj, Process* to, Uint extra) { * Return the "flat" size of the object. */ -Uint size_object(Eterm obj) +#define in_literal_purge_area(PTR) \ + (lit_purge_ptr && ( \ + (lit_purge_ptr <= (PTR) && \ + (PTR) < (lit_purge_ptr + lit_purge_sz)))) + +Uint size_object_x(Eterm obj, erts_literal_area_t *litopt) { Uint sum = 0; Eterm* ptr; int arity; + Eterm *lit_purge_ptr = litopt ? litopt->lit_purge_ptr : NULL; + Uint lit_purge_sz = litopt ? litopt->lit_purge_sz : 0; #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: - sum += 2; ptr = list_val(obj); + if (litopt && erts_is_literal(obj,ptr) && !in_literal_purge_area(ptr)) { + goto pop_next; + } + sum += 2; obj = *ptr++; if (!IS_CONST(obj)) { ESTACK_PUSH(s, obj); - } + } obj = *ptr; break; case TAG_PRIMARY_BOXED: { - Eterm hdr = *boxed_val(obj); + Eterm hdr; + ptr = boxed_val(obj); + if (litopt && erts_is_literal(obj,ptr) && !in_literal_purge_area(ptr)) { + goto pop_next; + } + hdr = *ptr; ASSERT(is_header(hdr)); switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: @@ -279,10 +293,6 @@ do { \ #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. @@ -599,7 +609,7 @@ cleanup: /* * Copy a structure to a heap. */ -Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz) +Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz, erts_literal_area_t *litopt) { char* hstart; Uint hsize; @@ -616,6 +626,8 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint Eterm hdr; Eterm *hend; int i; + Eterm *lit_purge_ptr = litopt ? litopt->lit_purge_ptr : NULL; + Uint lit_purge_sz = litopt ? litopt->lit_purge_sz : 0; #ifdef DEBUG Eterm org_obj = obj; Uint org_sz = sz; @@ -651,7 +663,6 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint L_copy: while (hp != htop) { obj = *hp; - switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: hp++; @@ -667,6 +678,10 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint L_copy_list: tailp = argp; + if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) { + *tailp = obj; + goto L_copy; + } for (;;) { tp = tailp; elem = CAR(objp); @@ -674,18 +689,23 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint hbot -= 2; CAR(hbot) = elem; tailp = &CDR(hbot); - } - else { + } else { CAR(htop) = elem; tailp = &CDR(htop); htop += 2; } *tp = make_list(tailp - 1); obj = CDR(objp); + if (!is_list(obj)) { break; } objp = list_val(obj); + + if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) { + *tailp = obj; + goto L_copy; + } } switch (primary_tag(obj)) { case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; @@ -695,7 +715,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint "%s, line %d: Internal error in copy_struct: 0x%08x\n", __FILE__, __LINE__,obj); } - + case TAG_PRIMARY_BOXED: if (ErtsInArea(boxed_val(obj),hstart,hsize)) { hp++; @@ -705,6 +725,10 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint L_copy_boxed: objp = boxed_val(obj); + if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) { + *argp = obj; + break; + } hdr = *objp; switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: @@ -765,7 +789,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint extra_bytes = 1; } else { extra_bytes = 0; - } + } real_size = size+extra_bytes; objp = binary_val(real_bin); if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { @@ -780,7 +804,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint } else { ProcBin* from = (ProcBin *) objp; ProcBin* to; - + ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG); if (from->flags) { erts_emasculate_writable_binary(from); @@ -900,6 +924,12 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz = hend - hbot; } else { #ifdef DEBUG + if (!eq(org_obj, res)) { + erts_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct() when copying %T:" + " not equal to copy %T\n", + org_obj, res); + } if (htop != hbot) erts_exit(ERTS_ABORT_EXIT, "Internal error in copy_struct() when copying %T:" @@ -1036,6 +1066,8 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) Uint e; unsigned sz; Eterm* ptr; + Eterm *lit_purge_ptr = info->lit_purge_ptr; + Uint lit_purge_sz = info->lit_purge_sz; #ifdef DEBUG Eterm mypid = erts_get_current_pid(); #endif @@ -1081,7 +1113,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) /* 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)) + if (in_literal_purge_area(ptr)) info->literal_size += size_object(obj); goto pop_next; } @@ -1132,7 +1164,7 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info) /* 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)) + if (in_literal_purge_area(ptr)) info->literal_size += size_object(obj); goto pop_next; } @@ -1298,6 +1330,8 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, Eterm* resp; Eterm *hbot, *hend; unsigned remaining; + Eterm *lit_purge_ptr = info->lit_purge_ptr; + Uint lit_purge_sz = info->lit_purge_sz; #ifdef DEBUG Eterm mypid = erts_get_current_pid(); Eterm saved_obj = obj; @@ -1347,11 +1381,11 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, ptr = list_val(obj); /* off heap list pointers are copied verbatim */ if (erts_is_literal(obj,ptr)) { - if (!IN_LITERAL_PURGE_AREA(info,ptr)) { + if (!in_literal_purge_area(ptr)) { *resp = obj; } else { Uint bsz = 0; - *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz, NULL); /* copy literal */ hbot -= bsz; } goto cleanup_next; @@ -1415,11 +1449,11 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info, 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)) { + if (!in_literal_purge_area(ptr)) { *resp = obj; } else { Uint bsz = 0; - *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz); + *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz, NULL); /* copy literal */ hbot -= bsz; } goto cleanup_next; @@ -1923,7 +1957,7 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int lite if (is_header(val)) { struct erl_off_heap_header* hdr = (struct erl_off_heap_header*)hp; ASSERT(ptr + header_arity(val) < end); - MOVE_BOXED(ptr, val, hp, &dummy_ref); + MOVE_BOXED(ptr, val, hp, &dummy_ref); switch (val & _HEADER_SUBTAG_MASK) { case REFC_BINARY_SUBTAG: case FUN_SUBTAG: diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c index b42d2dc28b..458315f293 100644 --- a/erts/emulator/beam/erl_bif_guard.c +++ b/erts/emulator/beam/erl_bif_guard.c @@ -141,6 +141,39 @@ BIF_RETTYPE trunc_1(BIF_ALIST_1) BIF_RET(res); } +BIF_RETTYPE floor_1(BIF_ALIST_1) +{ + Eterm res; + FloatDef f; + + if (is_not_float(BIF_ARG_1)) { + if (is_integer(BIF_ARG_1)) + BIF_RET(BIF_ARG_1); + BIF_ERROR(BIF_P, BADARG); + } + GET_DOUBLE(BIF_ARG_1, f); + res = double_to_integer(BIF_P, floor(f.fd)); + BIF_RET(res); +} + +BIF_RETTYPE ceil_1(BIF_ALIST_1) +{ + Eterm res; + FloatDef f; + + /* check arg */ + if (is_not_float(BIF_ARG_1)) { + if (is_integer(BIF_ARG_1)) + BIF_RET(BIF_ARG_1); + BIF_ERROR(BIF_P, BADARG); + } + /* get the float */ + GET_DOUBLE(BIF_ARG_1, f); + + res = double_to_integer(BIF_P, ceil(f.fd)); + BIF_RET(res); +} + BIF_RETTYPE round_1(BIF_ALIST_1) { Eterm res; @@ -621,6 +654,38 @@ Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live) reg, live); } +Eterm erts_gc_floor_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg; + FloatDef f; + + arg = reg[live]; + if (is_not_float(arg)) { + if (is_integer(arg)) { + return arg; + } + BIF_ERROR(p, BADARG); + } + GET_DOUBLE(arg, f); + return gc_double_to_integer(p, floor(f.fd), reg, live); +} + +Eterm erts_gc_ceil_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg; + FloatDef f; + + arg = reg[live]; + if (is_not_float(arg)) { + if (is_integer(arg)) { + return arg; + } + BIF_ERROR(p, BADARG); + } + GET_DOUBLE(arg, f); + return gc_double_to_integer(p, ceil(f.fd), reg, live); +} + static Eterm gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live) { diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 29ba12dfdb..75389107bb 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2391,7 +2391,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) ERTS_ATOM_ENC_LATIN1, 1), erts_bld_uint(hpp, hszp, - opc[i].count)), + erts_instr_count[i])), res); } @@ -2883,27 +2883,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(AM_tag); #endif } - else if (ERTS_IS_ATOM_STR("check_process_code",BIF_ARG_1)) { - Eterm terms[3]; - Sint length = 1; - Uint sz = 0; - Eterm *hp, res; - DECL_AM(direct_references); - - terms[0] = AM_direct_references; -#if !defined(ERTS_NEW_PURGE_STRATEGY) - { - DECL_AM(indirect_references); - terms[1] = AM_indirect_references; - terms[2] = am_copy_literals; - length = 3; - } -#endif - erts_bld_list(NULL, &sz, length, terms); - hp = HAlloc(BIF_P, sz); - res = erts_bld_list(&hp, NULL, length, terms); - BIF_RET(res); - } BIF_ERROR(BIF_P, BADARG); } @@ -3563,8 +3542,14 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) else if (ERTS_IS_ATOM_STR("DbTable_words", BIF_ARG_1)) { /* Used by ets_SUITE (stdlib) */ size_t words = (sizeof(DbTable) + sizeof(Uint) - 1)/sizeof(Uint); - BIF_RET(make_small((Uint) words)); + Eterm* hp = HAlloc(BIF_P ,3); + BIF_RET(TUPLE2(hp, make_small((Uint) words), + erts_ets_hash_sizeof_ext_segtab())); } + else if (ERTS_IS_ATOM_STR("DbTable_meta", BIF_ARG_1)) { + /* Used by ets_SUITE (stdlib) */ + BIF_RET(erts_ets_get_meta_state(BIF_P)); + } else if (ERTS_IS_ATOM_STR("check_io_debug", BIF_ARG_1)) { /* Used by driver_SUITE (emulator) */ Uint sz, *szp; @@ -4298,6 +4283,10 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } BIF_RET(am_ok); } + else if (ERTS_IS_ATOM_STR("DbTable_meta", BIF_ARG_1)) { + /* Used by ets_SUITE (stdlib) */ + BIF_RET(erts_ets_restore_meta_state(BIF_P, BIF_ARG_2)); + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 128a7b3865..485f68ca98 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -3978,6 +3978,36 @@ erts_ets_colliding_names(Process* p, Eterm name, Uint cnt) return list; } +/* + * For testing only + * Retreive meta table size state + */ +Eterm erts_ets_get_meta_state(Process* p) +{ + Eterm* hp = HAlloc(p, 3); + return TUPLE2(hp, + erts_ets_hash_get_memstate(p, &meta_pid_to_tab->hash), + erts_ets_hash_get_memstate(p, &meta_pid_to_fixed_tab->hash)); +} +/* + * For testing only + * Restore a previously retrieved meta table size state. + * We do this to suppress failed memory checks + * caused by the hysteresis of meta tables grow/shrink limits. + */ +Eterm erts_ets_restore_meta_state(Process* p, Eterm meta_state) +{ + Eterm* tv; + Eterm* hp; + if (!is_tuple_arity(meta_state, 2)) + return am_badarg; + + tv = tuple_val(meta_state); + hp = HAlloc(p, 3); + return TUPLE2(hp, + erts_ets_hash_restore_memstate(&meta_pid_to_tab->hash, tv[1]), + erts_ets_hash_restore_memstate(&meta_pid_to_fixed_tab->hash, tv[2])); +} #ifdef HARDDEBUG /* Here comes some debug functions */ diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index 1d26c49652..f7eb3dc45c 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -90,6 +90,8 @@ extern Export ets_select_continue_exp; extern erts_smp_atomic_t erts_ets_misc_mem_size; Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt); +Eterm erts_ets_get_meta_state(Process* p); +Eterm erts_ets_restore_meta_state(Process* p, Eterm target_state); Uint erts_db_get_max_tabs(void); @@ -267,7 +269,5 @@ erts_db_free_nt(ErtsAlcType_t type, void *ptr, Uint size) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#undef ERTS_DB_ALC_MEM_UPDATE_ - #endif /* #if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__) */ diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 5e6fe4f460..939ae57192 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -84,25 +84,28 @@ #include "erl_db_hash.h" -#ifdef MYDEBUG /* Will fail test case ets_SUITE:memory */ -# define IF_DEBUG(x) x -# define MY_ASSERT(x) ASSERT(x) -#else -# define IF_DEBUG(x) -# define MY_ASSERT(x) -#endif - /* * The following symbols can be manipulated to "tune" the linear hash array */ -#define CHAIN_LEN 6 /* Medium bucket chain len */ +#define GROW_LIMIT(NACTIVE) ((NACTIVE)*1) +#define SHRINK_LIMIT(NACTIVE) ((NACTIVE) / 2) -/* Number of slots per segment */ -#define SEGSZ_EXP 8 -#define SEGSZ (1 << SEGSZ_EXP) -#define SEGSZ_MASK (SEGSZ-1) +/* +** We want the first mandatory segment to be small (to reduce minimal footprint) +** and larger extra segments (to reduce number of alloc/free calls). +*/ -#define NSEG_1 2 /* Size of first segment table (must be at least 2) */ +/* Number of slots in first segment */ +#define FIRST_SEGSZ_EXP 8 +#define FIRST_SEGSZ (1 << FIRST_SEGSZ_EXP) +#define FIRST_SEGSZ_MASK (FIRST_SEGSZ - 1) + +/* Number of slots per extra segment */ +#define EXT_SEGSZ_EXP 11 +#define EXT_SEGSZ (1 << EXT_SEGSZ_EXP) +#define EXT_SEGSZ_MASK (EXT_SEGSZ-1) + +#define NSEG_1 (ErtsSizeofMember(DbTableHash,first_segtab) / sizeof(struct segment*)) #define NSEG_2 256 /* Size of second segment table */ #define NSEG_INC 128 /* Number of segments to grow after that */ @@ -123,7 +126,9 @@ #define NACTIVE(tb) ((int)erts_smp_atomic_read_nob(&(tb)->nactive)) #define NITEMS(tb) ((int)erts_smp_atomic_read_nob(&(tb)->common.nitems)) -#define BUCKET(tb, i) SEGTAB(tb)[(i) >> SEGSZ_EXP]->buckets[(i) & SEGSZ_MASK] +#define SLOT_IX_TO_SEG_IX(i) (((i)+(EXT_SEGSZ-FIRST_SEGSZ)) >> EXT_SEGSZ_EXP) + +#define BUCKET(tb, i) SEGTAB(tb)[SLOT_IX_TO_SEG_IX(i)]->buckets[(i) & EXT_SEGSZ_MASK] /* * When deleting a table, the number of records to delete. @@ -189,6 +194,7 @@ static ERTS_INLINE int add_fixed_deletion(DbTableHash* tb, int ix, #ifdef ERTS_SMP # define DB_HASH_LOCK_MASK (DB_HASH_LOCK_CNT-1) # define GET_LOCK(tb,hval) (&(tb)->locks->lck_vec[(hval) & DB_HASH_LOCK_MASK].lck) +# define GET_LOCK_MAYBE(tb,hval) ((tb)->common.is_thread_safe ? NULL : GET_LOCK(tb,hval)) /* Fine grained read lock */ static ERTS_INLINE erts_smp_rwmtx_t* RLOCK_HASH(DbTableHash* tb, HashValue hval) @@ -318,27 +324,23 @@ struct mp_info { /* A table segment */ struct segment { - HashDbTerm* buckets[SEGSZ]; -#ifdef MYDEBUG - int is_ext_segment; -#endif + HashDbTerm* buckets[1]; }; +#define SIZEOF_SEGMENT(N) \ + (offsetof(struct segment,buckets) + sizeof(HashDbTerm*)*(N)) -/* A segment that also contains a segment table */ -struct ext_segment { - struct segment s; /* The segment itself. Must be first */ - +/* An extended segment table */ +struct ext_segtab { +#ifdef ERTS_SMP + ErtsThrPrgrLaterOp lop; +#endif struct segment** prev_segtab; /* Used when table is shrinking */ - int nsegs; /* Size of segtab */ + int prev_nsegs; /* Size of prev_segtab */ + int nsegs; /* Size of this segtab */ struct segment* segtab[1]; /* The segment table */ }; -#define SIZEOF_EXTSEG(NSEGS) \ - (offsetof(struct ext_segment,segtab) + sizeof(struct segment*)*(NSEGS)) - -#if defined(DEBUG) || defined(VALGRIND) -# define EXTSEG(SEGTAB_PTR) \ - ((struct ext_segment*) (((char*)(SEGTAB_PTR)) - offsetof(struct ext_segment,segtab))) -#endif +#define SIZEOF_EXT_SEGTAB(NSEGS) \ + (offsetof(struct ext_segtab,segtab) + sizeof(struct segment*)*(NSEGS)) static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb, @@ -348,49 +350,22 @@ static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb, erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) segtab); else erts_smp_atomic_set_nob(&tb->segtab, (erts_aint_t) segtab); -#ifdef VALGRIND - tb->top_ptr_to_segment_with_active_segtab = EXTSEG(segtab); -#endif } -/* How the table segments relate to each other: - - ext_segment: ext_segment: "plain" segment - #=================# #================# #=============# - | bucket[0] |<--+ +------->| bucket[256] | +->| bucket[512] | - | bucket[1] | | | | [257] | | | [513] | - : : | | : : | : : - | bucket[255] | | | | [511] | | | [767] | - |-----------------| | | |----------------| | #=============# - | prev_segtab=NULL| | | +--<---prev_segtab | | - | nsegs = 2 | | | | | nsegs = 256 | | -+->| segtab[0] -->-------+---|---|--<---segtab[0] |<-+ | -| | segtab[1] -->-----------+---|--<---segtab[1] | | | -| #=================# | | segtab[2] -->-----|--+ ext_segment: -| | : : | #================# -+----------------<---------------+ | segtab[255] ->----|----->| bucket[255*256]| - #================# | | | - | : : - | |----------------| - +----<---prev_segtab | - : : -*/ - /* ** Forward decl's (static functions) */ -static struct ext_segment* alloc_ext_seg(DbTableHash* tb, unsigned seg_ix, - struct segment** old_segtab); -static int alloc_seg(DbTableHash *tb); +static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix); +static void alloc_seg(DbTableHash *tb); static int free_seg(DbTableHash *tb, int free_records); static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr, HashDbTerm *list); static HashDbTerm* search_list(DbTableHash* tb, Eterm key, HashValue hval, HashDbTerm *list); -static void shrink(DbTableHash* tb, int nactive); -static void grow(DbTableHash* tb, int nactive); +static void shrink(DbTableHash* tb, int nitems); +static void grow(DbTableHash* tb, int nitems); static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, Uint sz, DbTableHash*); static int analyze_pattern(DbTableHash *tb, Eterm pattern, @@ -463,9 +438,10 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle); static ERTS_INLINE void try_shrink(DbTableHash* tb) { int nactive = NACTIVE(tb); - if (nactive > SEGSZ && NITEMS(tb) < (nactive * CHAIN_LEN) + int nitems = NITEMS(tb); + if (nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive) && !IS_FIXED(tb)) { - shrink(tb, nactive); + shrink(tb, nitems); } } @@ -662,16 +638,20 @@ int db_create_hash(Process *p, DbTable *tbl) { DbTableHash *tb = &tbl->hash; - erts_smp_atomic_init_nob(&tb->szm, SEGSZ_MASK); - erts_smp_atomic_init_nob(&tb->nactive, SEGSZ); + erts_smp_atomic_init_nob(&tb->szm, FIRST_SEGSZ_MASK); + erts_smp_atomic_init_nob(&tb->nactive, FIRST_SEGSZ); erts_smp_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL); erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL); - SET_SEGTAB(tb, alloc_ext_seg(tb,0,NULL)->segtab); + SET_SEGTAB(tb, tb->first_segtab); tb->nsegs = NSEG_1; - tb->nslots = SEGSZ; + tb->nslots = FIRST_SEGSZ; + tb->first_segtab[0] = (struct segment*) erts_db_alloc(ERTS_ALC_T_DB_SEG, + (DbTable *) tb, + SIZEOF_SEGMENT(FIRST_SEGSZ)); + sys_memset(tb->first_segtab[0], 0, SIZEOF_SEGMENT(FIRST_SEGSZ)); - erts_smp_atomic_init_nob(&tb->is_resizing, 0); #ifdef ERTS_SMP + erts_smp_atomic_init_nob(&tb->is_resizing, 0); if (tb->common.type & DB_FINE_LOCKED) { erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; int i; @@ -686,7 +666,7 @@ int db_create_hash(Process *p, DbTable *tbl) erts_smp_rwmtx_init_opt_x(&tb->locks->lck_vec[i].lck, &rwmtx_opt, "db_hash_slot", make_small(i)); } - /* This important property is needed to guarantee that the buckets + /* This important property is needed to guarantee the two buckets * involved in a grow/shrink operation it protected by the same lock: */ ASSERT(erts_smp_atomic_read_nob(&tb->nactive) % DB_HASH_LOCK_CNT == 0); @@ -862,8 +842,8 @@ Lnew: WUNLOCK_HASH(lck); { int nactive = NACTIVE(tb); - if (nitems > nactive * (CHAIN_LEN+1) && !IS_FIXED(tb)) { - grow(tb, nactive); + if (nitems > GROW_LIMIT(nactive) && !IS_FIXED(tb)) { + grow(tb, nitems); } } CHECK_TABLES(); @@ -1514,6 +1494,7 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, match_list = CONS(hp, match_res, match_list); ++got; } + --num_left; } current = current->next; } @@ -1531,7 +1512,6 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, } } else { /* Key is variable */ - --num_left; if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) { slot_ix = -1; @@ -2250,12 +2230,12 @@ static int db_free_table_continue_hash(DbTable *tbl) done /= 2; while(tb->nslots != 0) { - free_seg(tb, 1); + done += 1 + EXT_SEGSZ/64 + free_seg(tb, 1); /* * If we have done enough work, get out here. */ - if (++done >= (DELETE_RECORD_LIMIT / CHAIN_LEN / SEGSZ)) { + if (done >= DELETE_RECORD_LIMIT) { return 0; /* Not done */ } } @@ -2414,90 +2394,81 @@ static int analyze_pattern(DbTableHash *tb, Eterm pattern, return DB_ERROR_NONE; } -static struct ext_segment* alloc_ext_seg(DbTableHash* tb, unsigned seg_ix, - struct segment** old_segtab) +static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix) { - int nsegs; - struct ext_segment* eseg; + struct segment** old_segtab = SEGTAB(tb); + int nsegs = 0; + struct ext_segtab* est; + ASSERT(seg_ix >= NSEG_1); switch (seg_ix) { - case 0: nsegs = NSEG_1; break; - case 1: nsegs = NSEG_2; break; - default: nsegs = seg_ix + NSEG_INC; break; - } - eseg = (struct ext_segment*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, - (DbTable *) tb, - SIZEOF_EXTSEG(nsegs)); - ASSERT(eseg != NULL); - sys_memset(&eseg->s, 0, sizeof(struct segment)); - IF_DEBUG(eseg->s.is_ext_segment = 1); - eseg->prev_segtab = old_segtab; - eseg->nsegs = nsegs; - if (old_segtab) { - ASSERT(nsegs > tb->nsegs); - sys_memcpy(eseg->segtab, old_segtab, tb->nsegs*sizeof(struct segment*)); - } + case NSEG_1: nsegs = NSEG_2; break; + default: nsegs = seg_ix + NSEG_INC; break; + } + ASSERT(nsegs > tb->nsegs); + est = (struct ext_segtab*) erts_db_alloc(ERTS_ALC_T_DB_SEG, + (DbTable *) tb, + SIZEOF_EXT_SEGTAB(nsegs)); + est->nsegs = nsegs; + est->prev_segtab = old_segtab; + est->prev_nsegs = tb->nsegs; + sys_memcpy(est->segtab, old_segtab, tb->nsegs*sizeof(struct segment*)); #ifdef DEBUG - sys_memset(&eseg->segtab[seg_ix], 0, (nsegs-seg_ix)*sizeof(struct segment*)); + sys_memset(&est->segtab[seg_ix], 0, (nsegs-seg_ix)*sizeof(struct segment*)); #endif - eseg->segtab[seg_ix] = &eseg->s; - return eseg; + return est; } /* Extend table with one new segment */ -static int alloc_seg(DbTableHash *tb) +static void alloc_seg(DbTableHash *tb) { - int seg_ix = tb->nslots >> SEGSZ_EXP; - - if (seg_ix+1 == tb->nsegs) { /* New segtab needed (extended segment) */ - struct segment** segtab = SEGTAB(tb); - struct ext_segment* seg = alloc_ext_seg(tb, seg_ix, segtab); - if (seg == NULL) return 0; - segtab[seg_ix] = &seg->s; - /* We don't use the new segtab until next call (see "shrink race") */ - } - else { /* Just a new plain segment */ - struct segment** segtab; - if (seg_ix == tb->nsegs) { /* Time to start use segtab from last call */ - struct ext_segment* eseg; - eseg = (struct ext_segment*) SEGTAB(tb)[seg_ix-1]; - MY_ASSERT(eseg!=NULL && eseg->s.is_ext_segment); - SET_SEGTAB(tb, eseg->segtab); - tb->nsegs = eseg->nsegs; - } - ASSERT(seg_ix < tb->nsegs); - segtab = SEGTAB(tb); - ASSERT(segtab[seg_ix] == NULL); - segtab[seg_ix] = (struct segment*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, - (DbTable *) tb, - sizeof(struct segment)); - if (segtab[seg_ix] == NULL) return 0; - sys_memset(segtab[seg_ix], 0, sizeof(struct segment)); - } - tb->nslots += SEGSZ; - return 1; + int seg_ix = SLOT_IX_TO_SEG_IX(tb->nslots); + struct segment** segtab; + + ASSERT(seg_ix > 0); + if (seg_ix == tb->nsegs) { /* New segtab needed */ + struct ext_segtab* est = alloc_ext_segtab(tb, seg_ix); + SET_SEGTAB(tb, est->segtab); + tb->nsegs = est->nsegs; + } + ASSERT(seg_ix < tb->nsegs); + segtab = SEGTAB(tb); + segtab[seg_ix] = (struct segment*) erts_db_alloc(ERTS_ALC_T_DB_SEG, + (DbTable *) tb, + SIZEOF_SEGMENT(EXT_SEGSZ)); + sys_memset(segtab[seg_ix], 0, SIZEOF_SEGMENT(EXT_SEGSZ)); + tb->nslots += EXT_SEGSZ; +} + +#ifdef ERTS_SMP +static void dealloc_ext_segtab(void* lop_data) +{ + struct ext_segtab* est = (struct ext_segtab*) lop_data; + + erts_free(ERTS_ALC_T_DB_SEG, est); } +#endif /* Shrink table by freeing the top segment ** free_records: 1=free any records in segment, 0=assume segment is empty */ static int free_seg(DbTableHash *tb, int free_records) { - const int seg_ix = (tb->nslots >> SEGSZ_EXP) - 1; + const int seg_ix = SLOT_IX_TO_SEG_IX(tb->nslots) - 1; struct segment** const segtab = SEGTAB(tb); - struct ext_segment* const top = (struct ext_segment*) segtab[seg_ix]; - int bytes; + struct segment* const segp = segtab[seg_ix]; + Uint seg_sz; int nrecords = 0; - ASSERT(top != NULL); + ASSERT(segp != NULL); #ifndef DEBUG if (free_records) #endif { - int i; - for (i=0; i<SEGSZ; ++i) { - HashDbTerm* p = top->s.buckets[i]; + int i = (seg_ix == 0) ? FIRST_SEGSZ : EXT_SEGSZ; + while (i--) { + HashDbTerm* p = segp->buckets[i]; while(p != 0) { HashDbTerm* nxt = p->next; ASSERT(free_records); /* segment not empty as assumed? */ @@ -2507,55 +2478,46 @@ static int free_seg(DbTableHash *tb, int free_records) } } } - - /* The "shrink race": - * We must avoid deallocating an extended segment while its segtab may - * still be used by other threads. - * The trick is to stop use a segtab one call earlier. That is, stop use - * a segtab when the segment above it is deallocated. When the segtab is - * later deallocated, it has not been used for a very long time. - * It is even theoretically safe as we have by then rehashed the entire - * segment, seizing *all* locks, so there cannot exist any retarded threads - * still hanging in BUCKET macro with an old segtab pointer. - * For this to work, we must of course allocate a new segtab one call - * earlier in alloc_seg() as well. And this is also the reason why - * the minimum size of the first segtab is 2 and not 1 (NSEG_1). - */ - if (seg_ix == tb->nsegs-1 || seg_ix==0) { /* Dealloc extended segment */ - MY_ASSERT(top->s.is_ext_segment); - ASSERT(segtab != top->segtab || seg_ix==0); - bytes = SIZEOF_EXTSEG(top->nsegs); - } - else { /* Dealloc plain segment */ - struct ext_segment* newtop = (struct ext_segment*) segtab[seg_ix-1]; - MY_ASSERT(!top->s.is_ext_segment); - - if (segtab == newtop->segtab) { /* New top segment is extended */ - MY_ASSERT(newtop->s.is_ext_segment); - if (newtop->prev_segtab != NULL) { - /* Time to use a smaller segtab */ - SET_SEGTAB(tb, newtop->prev_segtab); - tb->nsegs = seg_ix; - ASSERT(tb->nsegs == EXTSEG(SEGTAB(tb))->nsegs); - } - else { - ASSERT(NSEG_1 > 2 && seg_ix==1); - } - } - bytes = sizeof(struct segment); + if (seg_ix >= NSEG_1) { + struct ext_segtab* est = ErtsContainerStruct_(segtab,struct ext_segtab,segtab); + + if (seg_ix == est->prev_nsegs) { /* Dealloc extended segtab */ + ASSERT(est->prev_segtab != NULL); + SET_SEGTAB(tb, est->prev_segtab); + tb->nsegs = est->prev_nsegs; + +#ifdef ERTS_SMP + if (!tb->common.is_thread_safe) { + /* + * Table is doing a graceful shrink operation and we must avoid + * deallocating this segtab while it may still be read by other + * threads. Schedule deallocation with thread progress to make + * sure no lingering threads are still hanging in BUCKET macro + * with an old segtab pointer. + */ + Uint sz = SIZEOF_EXT_SEGTAB(est->nsegs); + ASSERT(sz == ERTS_ALC_DBG_BLK_SZ(est)); + ERTS_DB_ALC_MEM_UPDATE_(tb, sz, 0); + erts_schedule_thr_prgr_later_cleanup_op(dealloc_ext_segtab, + est, + &est->lop, + sz); + } + else +#endif + erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable*)tb, est, + SIZEOF_EXT_SEGTAB(est->nsegs)); + } } + seg_sz = (seg_ix == 0) ? FIRST_SEGSZ : EXT_SEGSZ; + erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb, segp, SIZEOF_SEGMENT(seg_sz)); - erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb, - (void*)top, bytes); #ifdef DEBUG - if (seg_ix > 0) { - segtab[seg_ix] = NULL; - } else { - SET_SEGTAB(tb, NULL); - } + if (seg_ix < tb->nsegs) + SEGTAB(tb)[seg_ix] = NULL; #endif - tb->nslots -= SEGSZ; + tb->nslots -= seg_sz; ASSERT(tb->nslots >= 0); return nrecords; } @@ -2604,104 +2566,111 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2, static ERTS_INLINE int begin_resizing(DbTableHash* tb) { +#ifdef ERTS_SMP if (DB_USING_FINE_LOCKING(tb)) - return !erts_smp_atomic_xchg_acqb(&tb->is_resizing, 1); - else { - if (erts_smp_atomic_read_nob(&tb->is_resizing)) - return 0; - erts_smp_atomic_set_nob(&tb->is_resizing, 1); - return 1; - } + return !erts_atomic_xchg_acqb(&tb->is_resizing, 1); + else + ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock)); +#endif + return 1; } static ERTS_INLINE void done_resizing(DbTableHash* tb) { +#ifdef ERTS_SMP if (DB_USING_FINE_LOCKING(tb)) - erts_smp_atomic_set_relb(&tb->is_resizing, 0); - else - erts_smp_atomic_set_nob(&tb->is_resizing, 0); + erts_atomic_set_relb(&tb->is_resizing, 0); +#endif } -/* Grow table with one new bucket. +/* Grow table with one or more new buckets. ** Allocate new segment if needed. */ -static void grow(DbTableHash* tb, int nactive) +static void grow(DbTableHash* tb, int nitems) { HashDbTerm** pnext; HashDbTerm** to_pnext; HashDbTerm* p; erts_smp_rwmtx_t* lck; - int from_ix; + int nactive; + int from_ix, to_ix; int szm; + int loop_limit = 5; - if (!begin_resizing(tb)) - return; /* already in progress */ - if (NACTIVE(tb) != nactive) { - goto abort; /* already done (race) */ - } - - /* Ensure that the slot nactive exists */ - if (nactive == tb->nslots) { - /* Time to get a new segment */ - ASSERT((nactive & SEGSZ_MASK) == 0); - if (!alloc_seg(tb)) goto abort; - } - ASSERT(nactive < tb->nslots); + do { + if (!begin_resizing(tb)) + return; /* already in progress */ + nactive = NACTIVE(tb); + if (nitems <= GROW_LIMIT(nactive)) { + goto abort; /* already done (race) */ + } - szm = erts_smp_atomic_read_nob(&tb->szm); - if (nactive <= szm) { - from_ix = nactive & (szm >> 1); - } else { - ASSERT(nactive == szm+1); - from_ix = 0; - szm = (szm<<1) | 1; - } + /* Ensure that the slot nactive exists */ + if (nactive == tb->nslots) { + /* Time to get a new segment */ + ASSERT(((nactive-FIRST_SEGSZ) & EXT_SEGSZ_MASK) == 0); + alloc_seg(tb); + } + ASSERT(nactive < tb->nslots); - lck = WLOCK_HASH(tb, from_ix); - /* Now a final double check (with the from_ix lock held) - * that we did not get raced by a table fixer. - */ - if (IS_FIXED(tb)) { - WUNLOCK_HASH(lck); - goto abort; - } - erts_smp_atomic_inc_nob(&tb->nactive); - if (from_ix == 0) { - if (DB_USING_FINE_LOCKING(tb)) - erts_smp_atomic_set_relb(&tb->szm, szm); - else - erts_smp_atomic_set_nob(&tb->szm, szm); - } - done_resizing(tb); + szm = erts_smp_atomic_read_nob(&tb->szm); + if (nactive <= szm) { + from_ix = nactive & (szm >> 1); + } else { + ASSERT(nactive == szm+1); + from_ix = 0; + szm = (szm<<1) | 1; + } + to_ix = nactive; + + lck = WLOCK_HASH(tb, from_ix); + ERTS_SMP_ASSERT(lck == GET_LOCK_MAYBE(tb,to_ix)); + /* Now a final double check (with the from_ix lock held) + * that we did not get raced by a table fixer. + */ + if (IS_FIXED(tb)) { + WUNLOCK_HASH(lck); + goto abort; + } + erts_smp_atomic_set_nob(&tb->nactive, ++nactive); + if (from_ix == 0) { + if (DB_USING_FINE_LOCKING(tb)) + erts_smp_atomic_set_relb(&tb->szm, szm); + else + erts_smp_atomic_set_nob(&tb->szm, szm); + } + done_resizing(tb); + + /* Finally, let's split the bucket. We try to do it in a smart way + to keep link order and avoid unnecessary updates of next-pointers */ + pnext = &BUCKET(tb, from_ix); + p = *pnext; + to_pnext = &BUCKET(tb, to_ix); + while (p != NULL) { + if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */ + *pnext = p->next; + free_term(tb, p); + p = *pnext; + } + else { + int ix = p->hvalue & szm; + if (ix != from_ix) { + ASSERT(ix == (from_ix ^ ((szm+1)>>1))); + *to_pnext = p; + /* Swap "from" and "to": */ + from_ix = ix; + to_pnext = pnext; + } + pnext = &p->next; + p = *pnext; + } + } + *to_pnext = NULL; + WUNLOCK_HASH(lck); - /* Finally, let's split the bucket. We try to do it in a smart way - to keep link order and avoid unnecessary updates of next-pointers */ - pnext = &BUCKET(tb, from_ix); - p = *pnext; - to_pnext = &BUCKET(tb, nactive); - while (p != NULL) { - if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */ - *pnext = p->next; - free_term(tb, p); - p = *pnext; - } - else { - int ix = p->hvalue & szm; - if (ix != from_ix) { - ASSERT(ix == (from_ix ^ ((szm+1)>>1))); - *to_pnext = p; - /* Swap "from" and "to": */ - from_ix = ix; - to_pnext = pnext; - } - pnext = &p->next; - p = *pnext; - } - } - *to_pnext = NULL; + }while (--loop_limit && nitems > GROW_LIMIT(nactive)); - WUNLOCK_HASH(lck); return; abort: @@ -2712,60 +2681,78 @@ abort: /* Shrink table by joining top bucket. ** Remove top segment if it gets empty. */ -static void shrink(DbTableHash* tb, int nactive) -{ - if (!begin_resizing(tb)) - return; /* already in progress */ - if (NACTIVE(tb) == nactive) { - erts_smp_rwmtx_t* lck; - int src_ix = nactive - 1; - int low_szm = erts_smp_atomic_read_nob(&tb->szm) >> 1; - int dst_ix = src_ix & low_szm; - - ASSERT(dst_ix < src_ix); - ASSERT(nactive > SEGSZ); - lck = WLOCK_HASH(tb, dst_ix); - /* Double check for racing table fixers */ - if (!IS_FIXED(tb)) { - HashDbTerm** src_bp = &BUCKET(tb, src_ix); - HashDbTerm** dst_bp = &BUCKET(tb, dst_ix); - HashDbTerm** bp = src_bp; - - /* Q: Why join lists by appending "dst" at the end of "src"? - A: Must step through "src" anyway to purge pseudo deleted. */ - while(*bp != NULL) { - if ((*bp)->hvalue == INVALID_HASH) { - HashDbTerm* deleted = *bp; - *bp = deleted->next; - free_term(tb, deleted); - } else { - bp = &(*bp)->next; - } - } - *bp = *dst_bp; - *dst_bp = *src_bp; - *src_bp = NULL; - - erts_smp_atomic_set_nob(&tb->nactive, src_ix); - if (dst_ix == 0) { - erts_smp_atomic_set_relb(&tb->szm, low_szm); - } - WUNLOCK_HASH(lck); - - if (tb->nslots - src_ix >= SEGSZ) { - free_seg(tb, 0); - } - } - else { - WUNLOCK_HASH(lck); - } +static void shrink(DbTableHash* tb, int nitems) +{ + HashDbTerm** src_bp; + HashDbTerm** dst_bp; + HashDbTerm** bp; + erts_smp_rwmtx_t* lck; + int src_ix, dst_ix, low_szm; + int nactive; + int loop_limit = 5; - } - /*else already done */ + do { + if (!begin_resizing(tb)) + return; /* already in progress */ + nactive = NACTIVE(tb); + if (!(nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive))) { + goto abort; /* already done (race) */ + } + src_ix = nactive - 1; + low_szm = erts_smp_atomic_read_nob(&tb->szm) >> 1; + dst_ix = src_ix & low_szm; + + ASSERT(dst_ix < src_ix); + ASSERT(nactive > FIRST_SEGSZ); + lck = WLOCK_HASH(tb, dst_ix); + ERTS_SMP_ASSERT(lck == GET_LOCK_MAYBE(tb,src_ix)); + /* Double check for racing table fixers */ + if (IS_FIXED(tb)) { + WUNLOCK_HASH(lck); + goto abort; + } + + src_bp = &BUCKET(tb, src_ix); + dst_bp = &BUCKET(tb, dst_ix); + bp = src_bp; + + /* + * We join lists by appending "dst" at the end of "src" + * as we must step through "src" anyway to purge pseudo deleted. + */ + while(*bp != NULL) { + if ((*bp)->hvalue == INVALID_HASH) { + HashDbTerm* deleted = *bp; + *bp = deleted->next; + free_term(tb, deleted); + } else { + bp = &(*bp)->next; + } + } + *bp = *dst_bp; + *dst_bp = *src_bp; + *src_bp = NULL; + + nactive = src_ix; + erts_smp_atomic_set_nob(&tb->nactive, nactive); + if (dst_ix == 0) { + erts_smp_atomic_set_relb(&tb->szm, low_szm); + } + WUNLOCK_HASH(lck); + + if (tb->nslots - src_ix >= EXT_SEGSZ) { + free_seg(tb, 0); + } + done_resizing(tb); + + } while (--loop_limit + && nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive)); + return; + +abort: done_resizing(tb); } - /* Search a list of tuples for a matching key */ static HashDbTerm* search_list(DbTableHash* tb, Eterm key, @@ -2931,8 +2918,8 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) WUNLOCK_HASH(lck); nactive = NACTIVE(tb); - if (nitems > nactive * (CHAIN_LEN + 1) && !IS_FIXED(tb)) { - grow(tb, nactive); + if (nitems > GROW_LIMIT(nactive) && !IS_FIXED(tb)) { + grow(tb, nitems); } } else { WUNLOCK_HASH(lck); @@ -3016,6 +3003,51 @@ void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats) stats->std_dev_expected = sqrt(stats->avg_chain_len * (1 - 1.0/NACTIVE(tb))); stats->kept_items = kept_items; } + +/* For testing only */ +Eterm erts_ets_hash_sizeof_ext_segtab(void) +{ + return make_small(((SIZEOF_EXT_SEGTAB(0)-1) / sizeof(UWord)) + 1); +} +/* For testing only */ +Eterm erts_ets_hash_get_memstate(Process* p, DbTableHash* tb) +{ + Eterm seg_cnt; + while (!begin_resizing(tb)) + /*spinn*/; + + seg_cnt = make_small(SLOT_IX_TO_SEG_IX(tb->nslots)); + done_resizing(tb); + return seg_cnt; +} +/* For testing only */ +Eterm erts_ets_hash_restore_memstate(DbTableHash* tb, Eterm memstate) +{ + int seg_cnt, target; + + if (!is_small(memstate)) + return make_small(__LINE__); + + target = signed_val(memstate); + if (target < 1) + return make_small(__LINE__); + while (1) { + while (!begin_resizing(tb)) + /*spin*/; + seg_cnt = SLOT_IX_TO_SEG_IX(tb->nslots); + done_resizing(tb); + + if (target == seg_cnt) + return am_ok; + if (IS_FIXED(tb)) + return make_small(__LINE__); + if (target < seg_cnt) + shrink(tb, 0); + else + grow(tb, INT_MAX); + } +} + #ifdef HARDDEBUG void db_check_table_hash(DbTable *tbl) @@ -3024,7 +3056,7 @@ void db_check_table_hash(DbTable *tbl) HashDbTerm* list; int j; - for (j = 0; j < tb->nactive; j++) { + for (j = 0; j < NACTIVE(tb); j++) { if ((list = BUCKET(tb,j)) != 0) { while (list != 0) { if (!is_tuple(make_tuple(list->dbterm.tpl))) { diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index e654363cd5..6d25c73549 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -50,23 +50,23 @@ typedef struct db_table_hash_fine_locks { typedef struct db_table_hash { DbTableCommon common; - erts_smp_atomic_t segtab; /* The segment table (struct segment**) */ + /* SMP: szm and nactive are write-protected by is_resizing or table write lock */ erts_smp_atomic_t szm; /* current size mask. */ - + erts_smp_atomic_t nactive; /* Number of "active" slots */ + + erts_smp_atomic_t segtab; /* The segment table (struct segment**) */ + struct segment* first_segtab[1]; + /* SMP: nslots and nsegs are protected by is_resizing or table write lock */ int nslots; /* Total number of slots */ int nsegs; /* Size of segment table */ /* List of slots where elements have been deleted while table was fixed */ erts_smp_atomic_t fixdel; /* (FixedDeletion*) */ - erts_smp_atomic_t nactive; /* Number of "active" slots */ - erts_smp_atomic_t is_resizing; /* grow/shrink in progress */ #ifdef ERTS_SMP + erts_smp_atomic_t is_resizing; /* grow/shrink in progress */ DbTableHashFineLocks* locks; #endif -#ifdef VALGRIND - struct ext_segment* top_ptr_to_segment_with_active_segtab; -#endif } DbTableHash; @@ -109,5 +109,8 @@ typedef struct { }DbHashStats; void db_calc_stats_hash(DbTableHash* tb, DbHashStats*); +Eterm erts_ets_hash_sizeof_ext_segtab(void); +Eterm erts_ets_hash_get_memstate(Process*, DbTableHash* tb); +Eterm erts_ets_hash_restore_memstate(DbTableHash* tb, Eterm memstate); #endif /* _DB_HASH_H */ diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 6f641a1ea7..db262d35c5 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -2182,26 +2182,18 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, *hp++ = val; break; case TAG_PRIMARY_LIST: -#ifdef SHCOPY_SEND if (erts_is_literal(val,list_val(val))) { *hp++ = val; } else { *hp++ = offset_ptr(val, offs); } -#else - *hp++ = offset_ptr(val, offs); -#endif break; case TAG_PRIMARY_BOXED: -#ifdef SHCOPY_SEND if (erts_is_literal(val,boxed_val(val))) { *hp++ = val; } else { *hp++ = offset_ptr(val, offs); } -#else - *hp++ = offset_ptr(val, offs); -#endif break; case TAG_PRIMARY_HEADER: *hp++ = val; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 781bf024dd..b299ac8d64 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -2264,7 +2264,6 @@ erl_start(int argc, char **argv) ASSERT(erts_code_purger && erts_code_purger->common.id == pid); erts_proc_inc_refc(erts_code_purger); -#ifdef ERTS_NEW_PURGE_STRATEGY pid = erl_system_process_otp(otp_ring0_pid, "erts_literal_area_collector"); erts_literal_area_collector = (Process *) erts_ptab_pix2intptr_ddrb(&erts_proc, @@ -2272,7 +2271,6 @@ erl_start(int argc, char **argv) ASSERT(erts_literal_area_collector && erts_literal_area_collector->common.id == pid); erts_proc_inc_refc(erts_literal_area_collector); -#endif #ifdef ERTS_DIRTY_SCHEDULERS pid = erl_system_process_otp(otp_ring0_pid, "erts_dirty_process_code_checker"); @@ -2302,7 +2300,7 @@ erl_start(int argc, char **argv) #endif set_main_stack_size(); erts_sched_init_time_sup(esdp); - process_main(); + process_main(esdp->x_reg_array, esdp->f_reg_array); } #endif } diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 06266363b5..356f5ca71e 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -113,10 +113,8 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "export_tab", NULL }, { "fun_tab", NULL }, { "environ", NULL }, -#ifdef ERTS_NEW_PURGE_STRATEGY { "release_literal_areas", NULL }, #endif -#endif { "efile_drv", "address" }, { "drv_ev_state_grow", NULL, }, { "drv_ev_state", "address" }, diff --git a/erts/emulator/beam/erl_math.c b/erts/emulator/beam/erl_math.c index fc0aaed18a..990fa63bd4 100644 --- a/erts/emulator/beam/erl_math.c +++ b/erts/emulator/beam/erl_math.c @@ -247,6 +247,12 @@ BIF_RETTYPE math_pow_2(BIF_ALIST_2) return math_call_2(BIF_P, pow, BIF_ARG_1, BIF_ARG_2); } +BIF_RETTYPE math_ceil_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, ceil, BIF_ARG_1); +} - - +BIF_RETTYPE math_floor_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, floor, BIF_ARG_1); +} diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index e4c696ae3b..118adc0c1b 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -696,6 +696,9 @@ erts_send_message(Process* sender, erts_aint32_t receiver_state; #ifdef SHCOPY_SEND erts_shcopy_t info; +#else + erts_literal_area_t litarea; + INITIALIZE_LITERAL_PURGE_AREA(litarea); #endif #ifdef USE_VM_PROBES @@ -725,7 +728,7 @@ erts_send_message(Process* sender, */ if (have_seqtrace(stoken)) { seq_trace_update_send(sender); - seq_trace_output(stoken, message, SEQ_TRACE_SEND, + seq_trace_output(stoken, message, SEQ_TRACE_SEND, receiver->common.id, sender); seq_trace_size = 6; /* TUPLE5 */ } @@ -741,7 +744,7 @@ erts_send_message(Process* sender, INITIALIZE_SHCOPY(info); msize = copy_shared_calculate(message, &info); #else - msize = size_object(message); + msize = size_object_litopt(message, &litarea); #endif mp = erts_alloc_message_heap_state(receiver, &receiver_state, @@ -760,7 +763,7 @@ erts_send_message(Process* sender, DESTROY_SHCOPY(info); #else if (is_not_immed(message)) - message = copy_struct(message, msize, &hp, ohp); + message = copy_struct_litopt(message, msize, &hp, ohp, &litarea); #endif if (is_immed(stoken)) token = stoken; @@ -796,7 +799,7 @@ erts_send_message(Process* sender, INITIALIZE_SHCOPY(info); msize = copy_shared_calculate(message, &info); #else - msize = size_object(message); + msize = size_object_litopt(message, &litarea); #endif mp = erts_alloc_message_heap_state(receiver, &receiver_state, @@ -810,7 +813,7 @@ erts_send_message(Process* sender, DESTROY_SHCOPY(info); #else if (is_not_immed(message)) - message = copy_struct(message, msize, &hp, ohp); + message = copy_struct_litopt(message, msize, &hp, ohp, &litarea); #endif } #ifdef USE_VM_PROBES @@ -998,8 +1001,8 @@ erts_move_messages_off_heap(Process *c_p) hp = hfrag->mem; if (is_not_immed(ERL_MESSAGE_TERM(mp))) ERL_MESSAGE_TERM(mp) = copy_struct(ERL_MESSAGE_TERM(mp), - msg_sz, &hp, - &hfrag->off_heap); + msg_sz, &hp, + &hfrag->off_heap); if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp), token_sz, &hp, diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 3a547982da..b53d3d4c19 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -687,9 +687,12 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, MBUF(&menv->phony_proc) = NULL; } } else { - Uint sz = size_object(msg); + erts_literal_area_t litarea; ErlOffHeap *ohp; Eterm *hp; + Uint sz; + INITIALIZE_LITERAL_PURGE_AREA(litarea); + sz = size_object_litopt(msg, &litarea); if (env && !env->tracee) { full_flush_env(env); mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp); @@ -709,7 +712,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, ohp = &bp->off_heap; } } - msg = copy_struct(msg, sz, &hp, ohp); + msg = copy_struct_litopt(msg, sz, &hp, ohp, &litarea); } ERL_MESSAGE_TERM(mp) = msg; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index bc59147c6c..269518d8d6 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -446,11 +446,10 @@ int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP; #endif typedef enum { - ERTS_PSTT_GC, /* Garbage Collect */ + ERTS_PSTT_GC_MAJOR, /* Garbage Collect: Fullsweep */ + ERTS_PSTT_GC_MINOR, /* Garbage Collect: Generational */ ERTS_PSTT_CPC, /* Check Process Code */ -#ifdef ERTS_NEW_PURGE_STRATEGY ERTS_PSTT_CLA, /* Copy Literal Area */ -#endif ERTS_PSTT_COHMQ, /* Change off heap message queue */ ERTS_PSTT_FTMQ /* Flush trace msg queue */ } ErtsProcSysTaskType; @@ -8169,7 +8168,8 @@ sched_thread_func(void *vesdp) ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); #endif - process_main(); + process_main(esdp->x_reg_array, esdp->f_reg_array); + /* No schedulers should *ever* terminate */ erts_exit(ERTS_ABORT_EXIT, "Scheduler thread number %beu terminated\n", @@ -10414,7 +10414,8 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) break; switch (st->type) { - case ERTS_PSTT_GC: + case ERTS_PSTT_GC_MAJOR: + case ERTS_PSTT_GC_MINOR: if (c_p->flags & F_DISABLE_GC) { save_gc_task(c_p, st, st_prio); st = NULL; @@ -10422,7 +10423,9 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) } else { if (!garbage_collected) { - FLAGS(c_p) |= F_NEED_FULLSWEEP; + if (st->type == ERTS_PSTT_GC_MAJOR) { + FLAGS(c_p) |= F_NEED_FULLSWEEP; + } reds -= scheduler_gc_proc(c_p, reds); garbage_collected = 1; } @@ -10438,7 +10441,6 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) fcalls = reds - CONTEXT_REDS; st_res = erts_check_process_code(c_p, st->arg[0], - unsigned_val(st->arg[1]), &cpc_reds, fcalls); reds -= cpc_reds; @@ -10449,7 +10451,6 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) } break; } -#ifdef ERTS_NEW_PURGE_STRATEGY case ERTS_PSTT_CLA: { int fcalls; int cla_reds = 0; @@ -10469,7 +10470,6 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) } break; } -#endif case ERTS_PSTT_COHMQ: reds -= erts_complete_off_heap_message_queue_change(c_p); st_res = am_true; @@ -10519,16 +10519,15 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) break; switch (st->type) { - case ERTS_PSTT_GC: + case ERTS_PSTT_GC_MAJOR: + case ERTS_PSTT_GC_MINOR: case ERTS_PSTT_CPC: case ERTS_PSTT_COHMQ: st_res = am_false; break; -#ifdef ERTS_NEW_PURGE_STRATEGY case ERTS_PSTT_CLA: st_res = am_ok; break; -#endif #ifdef ERTS_SMP case ERTS_PSTT_FTMQ: reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN); @@ -10694,17 +10693,19 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, switch (req_type) { case am_garbage_collect: - st->type = ERTS_PSTT_GC; - noproc_res = am_false; - if (!rp) + switch (st->arg[0]) { + case am_minor: st->type = ERTS_PSTT_GC_MINOR; break; + case am_major: st->type = ERTS_PSTT_GC_MAJOR; break; + default: goto badarg; + } + noproc_res = am_false; + if (!rp) goto noproc; break; case am_check_process_code: if (is_not_atom(st->arg[0])) goto badarg; - if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL)) - goto badarg; noproc_res = am_false; st->type = ERTS_PSTT_CPC; if (!rp) @@ -10720,7 +10721,6 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, #endif break; -#ifdef ERTS_NEW_PURGE_STRATEGY case am_copy_literals: if (st->arg[0] != am_true && st->arg[0] != am_false) goto badarg; @@ -10729,7 +10729,6 @@ request_system_task(Process *c_p, Eterm requester, Eterm target, if (!rp) goto noproc; break; -#endif default: goto badarg; @@ -11379,6 +11378,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). #ifdef SHCOPY_SPAWN erts_shcopy_t info; INITIALIZE_SHCOPY(info); +#else + erts_literal_area_t litarea; + INITIALIZE_LITERAL_PURGE_AREA(litarea); #endif erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR); @@ -11437,7 +11439,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). #ifdef SHCOPY_SPAWN arg_size = copy_shared_calculate(args, &info); #else - arg_size = size_object(args); + arg_size = size_object_litopt(args, &litarea); #endif heap_need = arg_size; @@ -11461,7 +11463,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). } p->schedule_count = 0; ASSERT(p->min_heap_size == erts_next_heap_size(p->min_heap_size, 0)); - + p->u.initial[INITIAL_MOD] = mod; p->u.initial[INITIAL_FUN] = func; p->u.initial[INITIAL_ARI] = (Uint) arity; @@ -11519,7 +11521,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). 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); + p->arg_reg[2] = copy_struct_litopt(args, arg_size, &p->htop, &p->off_heap, &litarea); #endif p->arity = 3; diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index f97716d030..60c2349f36 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -146,11 +146,12 @@ typedef struct op_entry { int sz; /* Number of loaded words. */ char* pack; /* Instructions for packing engine. */ char* sign; /* Signature string. */ - unsigned count; /* Number of times executed. */ } OpEntry; -extern OpEntry opc[]; /* Description of all instructions. */ -extern int num_instructions; /* Number of instruction in opc[]. */ +extern const OpEntry opc[]; /* Description of all instructions. */ +extern const int num_instructions; /* Number of instruction in opc[]. */ + +extern Uint erts_instr_count[]; /* some constants for various table sizes etc */ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index b2c76aa605..93996e8b41 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1000,12 +1000,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg); Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); /* beam_bif_load.c */ -#define ERTS_CPC_ALLOW_GC (1 << 0) -#define ERTS_CPC_ALL ERTS_CPC_ALLOW_GC -Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls); -#ifdef ERTS_NEW_PURGE_STRATEGY +Eterm erts_check_process_code(Process *c_p, Eterm module, int *redsp, int fcalls); Eterm erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed); -#endif typedef struct ErtsLiteralArea_ { struct erl_off_heap_header *off_heap; @@ -1019,10 +1015,7 @@ typedef struct ErtsLiteralArea_ { extern erts_smp_atomic_t erts_copy_literal_area__; #define ERTS_COPY_LITERAL_AREA() \ ((ErtsLiteralArea *) erts_smp_atomic_read_nob(&erts_copy_literal_area__)) - -#ifdef ERTS_NEW_PURGE_STRATEGY extern Process *erts_literal_area_collector; -#endif #ifdef ERTS_DIRTY_SCHEDULERS extern Process *erts_dirty_process_code_checker; #endif @@ -1104,26 +1097,26 @@ typedef struct { Eterm* shtable_start; ErtsAlcType_t shtable_alloc_type; Uint literal_size; - Eterm *range_ptr; - Uint range_sz; + Eterm *lit_purge_ptr; + Uint lit_purge_sz; } erts_shcopy_t; -#define INITIALIZE_SHCOPY(info) \ -do { \ - ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA();\ - info.queue_start = info.queue_default; \ - info.bitstore_start = info.bitstore_default; \ - info.shtable_start = info.shtable_default; \ - info.literal_size = 0; \ - if (larea__) { \ - info.range_ptr = &larea__->start[0]; \ - info.range_sz = larea__->end - info.range_ptr; \ - } \ - else { \ - info.range_ptr = NULL; \ - info.range_sz = 0; \ - } \ -} while(0) +#define INITIALIZE_SHCOPY(info) \ + do { \ + ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA(); \ + info.queue_start = info.queue_default; \ + info.bitstore_start = info.bitstore_default; \ + info.shtable_start = info.shtable_default; \ + info.literal_size = 0; \ + if (larea__) { \ + info.lit_purge_ptr = &larea__->start[0]; \ + info.lit_purge_sz = larea__->end - info.lit_purge_ptr; \ + } \ + else { \ + info.lit_purge_ptr = NULL; \ + info.lit_purge_sz = 0; \ + } \ + } while(0) #define DESTROY_SHCOPY(info) \ do { \ @@ -1139,18 +1132,42 @@ do { \ } while(0) /* copy.c */ +typedef struct { + Eterm *lit_purge_ptr; + Uint lit_purge_sz; +} erts_literal_area_t; + +#define INITIALIZE_LITERAL_PURGE_AREA(Area) \ + do { \ + ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA(); \ + if (larea__) { \ + (Area).lit_purge_ptr = &larea__->start[0]; \ + (Area).lit_purge_sz = larea__->end - (Area).lit_purge_ptr; \ + } \ + else { \ + (Area).lit_purge_ptr = NULL; \ + (Area).lit_purge_sz = 0; \ + } \ + } while(0) + Eterm copy_object_x(Eterm, Process*, Uint); #define copy_object(Term, Proc) copy_object_x(Term,Proc,0) -Uint size_object(Eterm); +Uint size_object_x(Eterm, erts_literal_area_t*); +#define size_object(Term) size_object_x(Term,NULL) +#define size_object_litopt(Term,LitArea) size_object_x(Term,LitArea) + 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); +Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint*, erts_literal_area_t*); #define copy_struct(Obj,Sz,HPP,OH) \ - copy_struct_x(Obj,Sz,HPP,OH,NULL) + copy_struct_x(Obj,Sz,HPP,OH,NULL,NULL) +#define copy_struct_litopt(Obj,Sz,HPP,OH,LitArea) \ + copy_struct_x(Obj,Sz,HPP,OH,NULL,LitArea) + Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first, @@ -1179,7 +1196,7 @@ void print_pass_through(int, byte*, int); /* beam_emu.c */ int catchlevel(Process*); void init_emulator(void); -void process_main(void); +void process_main(Eterm* x_reg_array, FloatDef* f_reg_array); void erts_dirty_process_main(ErtsSchedulerData *); Eterm build_stacktrace(Process* c_p, Eterm exc); Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value); @@ -1452,18 +1469,6 @@ Eterm erts_gc_bor(Process* p, Eterm* reg, Uint live); Eterm erts_gc_bxor(Process* p, Eterm* reg, Uint live); Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live); - Uint erts_current_reductions(Process* current, Process *p); int erts_print_system_version(int to, void *arg, Process *c_p); diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 879daaca0a..4ef04d020a 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -792,14 +792,14 @@ allocate_init t I y ################################################################# # -# The BIFs erts_internal:check_process_code/2 must be called like a function, +# The BIFs erts_internal:check_process_code/1 must be called like a function, # to ensure that c_p->i (program counter) is set correctly (an ordinary # BIF call doesn't set it). # -call_ext u==2 Bif=u$bif:erts_internal:check_process_code/2 => i_call_ext Bif -call_ext_last u==2 Bif=u$bif:erts_internal:check_process_code/2 D => i_call_ext_last Bif D -call_ext_only u==2 Bif=u$bif:erts_internal:check_process_code/2 => i_call_ext_only Bif +call_ext u==1 Bif=u$bif:erts_internal:check_process_code/1 => i_call_ext Bif +call_ext_last u==1 Bif=u$bif:erts_internal:check_process_code/1 D => i_call_ext_last Bif D +call_ext_only u==1 Bif=u$bif:erts_internal:check_process_code/1 => i_call_ext_only Bif # # The BIFs erlang:garbage_collect/0 must be called like a function, @@ -811,6 +811,10 @@ call_ext u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext Bif call_ext_last u==0 Bif=u$bif:erlang:garbage_collect/0 D => i_call_ext_last Bif D call_ext_only u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext_only Bif +call_ext u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext Bif +call_ext_last u==1 Bif=u$bif:erts_internal:garbage_collect/1 D => i_call_ext_last Bif D +call_ext_only u==1 Bif=u$bif:erts_internal:garbage_collect/1 => i_call_ext_only Bif + # # put/2 and erase/1 must be able to do garbage collection, so we must call # them like functions. diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index dfe82cab44..16e6c33367 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -99,6 +99,12 @@ #define ErtsContainerStruct(ptr, type, member) \ ((type *)((char *)(1 ? (ptr) : &((type *)0)->member) - offsetof(type, member))) +/* Use this variant when the member is an array */ +#define ErtsContainerStruct_(ptr, type, memberv) \ + ((type *)((char *)(1 ? (ptr) : ((type *)0)->memberv) - offsetof(type, memberv))) + +#define ErtsSizeofMember(type, member) sizeof(((type *)0)->member) + #if defined (__WIN32__) # include "erl_win_sys.h" #else diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 440ba956d8..066cf87c9d 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -44,30 +44,34 @@ #define INFLATE_INIT 8 #define INFLATE_INIT2 9 #define INFLATE_SETDICT 10 -#define INFLATE_SYNC 11 -#define INFLATE_RESET 12 -#define INFLATE_END 13 -#define INFLATE 14 +#define INFLATE_GETDICT 11 +#define INFLATE_SYNC 12 +#define INFLATE_RESET 13 +#define INFLATE_END 14 +#define INFLATE 15 -#define CRC32_0 15 -#define CRC32_1 16 -#define CRC32_2 17 +#define CRC32_0 16 +#define CRC32_1 17 +#define CRC32_2 18 -#define SET_BUFSZ 18 -#define GET_BUFSZ 19 -#define GET_QSIZE 20 +#define SET_BUFSZ 19 +#define GET_BUFSZ 20 +#define GET_QSIZE 21 -#define ADLER32_1 21 -#define ADLER32_2 22 +#define ADLER32_1 22 +#define ADLER32_2 23 -#define CRC32_COMBINE 23 -#define ADLER32_COMBINE 24 +#define CRC32_COMBINE 24 +#define ADLER32_COMBINE 25 -#define INFLATE_CHUNK 25 +#define INFLATE_CHUNK 26 #define DEFAULT_BUFSZ 4000 +/* According to zlib documentation, it can never exceed this */ +#define INFL_DICT_SZ 32768 + /* This flag is used in the same places, where zlib return codes * (Z_OK, Z_STREAM_END, Z_NEED_DICT) are. So, we need to set it to * relatively large value to avoid possible value clashes in future. @@ -248,6 +252,20 @@ static int zlib_output(ZLibData* d) return zlib_output_init(d); } +#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY +static int zlib_inflate_get_dictionary(ZLibData* d) +{ + ErlDrvBinary* dbin = driver_alloc_binary(INFL_DICT_SZ); + uInt dlen = 0; + int res = inflateGetDictionary(&d->s, (unsigned char*)dbin->orig_bytes, &dlen); + if ((res == Z_OK) && (driver_output_binary(d->port, NULL, 0, dbin, 0, dlen) < 0)) { + res = Z_ERRNO; + } + driver_free_binary(dbin); + return res; +} +#endif + static int zlib_inflate(ZLibData* d, int flush) { int res = Z_OK; @@ -586,6 +604,16 @@ static ErlDrvSSizeT zlib_ctl(ErlDrvData drv_data, unsigned int command, char *bu res = inflateSetDictionary(&d->s, (unsigned char*)buf, len); return zlib_return(res, rbuf, rlen); + case INFLATE_GETDICT: +#ifdef HAVE_ZLIB_INFLATEGETDICTIONARY + if (d->state != ST_INFLATE) goto badarg; + res = zlib_inflate_get_dictionary(d); + return zlib_return(res, rbuf, rlen); +#else + errno = ENOTSUP; + return zlib_return(Z_ERRNO, rbuf, rlen); +#endif + case INFLATE_SYNC: if (d->state != ST_INFLATE) goto badarg; if (len != 0) goto badarg; diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index dcf3447af9..bb328b5915 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -153,7 +153,7 @@ standard_bif_interface_0(nbif_ports_0, ports_0) * BIFs and primops that may do a GC (change heap limit and walk the native stack). * XXX: erase/1 and put/2 cannot fail */ -gc_bif_interface_2(nbif_erts_internal_check_process_code_2, hipe_erts_internal_check_process_code_2) +gc_bif_interface_1(nbif_erts_internal_check_process_code_1, hipe_erts_internal_check_process_code_1) gc_bif_interface_1(nbif_erase_1, erase_1) gc_bif_interface_0(nbif_garbage_collect_0, garbage_collect_0) gc_nofail_primop_interface_1(nbif_gc_1, hipe_gc) diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 9c03b3811c..9439b823ab 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -42,7 +42,7 @@ */ /* for -Wmissing-prototypes :-( */ -extern Eterm hipe_erts_internal_check_process_code_2(BIF_ALIST_2); +extern Eterm hipe_erts_internal_check_process_code_1(BIF_ALIST_1); extern Eterm hipe_show_nstack_1(BIF_ALIST_1); /* Used when a BIF can trigger a stack walk. */ @@ -51,12 +51,12 @@ static __inline__ void hipe_set_narity(Process *p, unsigned int arity) p->hipe.narity = arity; } -Eterm hipe_erts_internal_check_process_code_2(BIF_ALIST_2) +Eterm hipe_erts_internal_check_process_code_1(BIF_ALIST_1) { Eterm ret; - hipe_set_narity(BIF_P, 2); - ret = erts_internal_check_process_code_2(BIF_P, BIF__ARGS); + hipe_set_narity(BIF_P, 1); + ret = erts_internal_check_process_code_1(BIF_P, BIF__ARGS); hipe_set_narity(BIF_P, 0); return ret; } diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 34515efa3d..8427bb134d 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -22,8 +22,7 @@ -export([all/0, suite/0, init_per_suite/1, end_per_suite/1, versions/1,new_binary_types/1, call_purged_fun_code_gone/1, call_purged_fun_code_reload/1, call_purged_fun_code_there/1, - t_check_process_code/1,t_check_old_code/1, - t_check_process_code_ets/1, + multi_proc_purge/1, t_check_old_code/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, @@ -36,8 +35,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [versions, new_binary_types, call_purged_fun_code_gone, - call_purged_fun_code_reload, call_purged_fun_code_there, t_check_process_code, - t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, + call_purged_fun_code_reload, call_purged_fun_code_there, + multi_proc_purge, 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, t_copy_literals, t_copy_literals_frags]. @@ -276,96 +275,62 @@ call_purged_fun_test(Priv, Data, Type) -> end, ok. -t_check_process_code(Config) when is_list(Config) -> - case check_process_code_handle(indirect_references) of - false -> {skipped, "check_process_code() ignores funs"}; - true -> t_check_process_code_test(Config) - end. - -t_check_process_code_test(Config) -> +multi_proc_purge(Config) when is_list(Config) -> + %% + %% Make sure purge requests aren't lost when + %% purger process is working. + %% Priv = proplists:get_value(priv_dir, Config), Data = proplists:get_value(data_dir, Config), - File = filename:join(Data, "my_code_test"), - Code = filename:join(Priv, "my_code_test"), - - catch erlang:purge_module(my_code_test), - catch erlang:delete_module(my_code_test), - catch erlang:purge_module(my_code_test), - - {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - MyFun = fun(X, Y) -> X + Y end, %Confuse things. - F = my_code_test:make_fun(42), - 2 = fun_refc(F), - MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. - 44 = F(2), - - %% Delete the module and call the fun again. - true = erlang:delete_module(my_code_test), - 2 = fun_refc(F), - 45 = F(3), - {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), - - %% The fun should still be there, preventing purge. - true = erlang:check_process_code(self(), my_code_test), - gc(), - gc(), %Place funs on the old heap. - true = erlang:check_process_code(self(), my_code_test), - - %% Using the funs here guarantees that they will not be prematurely garbed. - 48 = F(6), - 3 = MyFun(1, 2), - 12 = MyFun2(3, 4), - - %% Kill all funs. - t_check_process_code1(Code, []). - -%% The real fun was killed, but we have some fakes which look similar. - -t_check_process_code1(Code, Fakes) -> - MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. - false = erlang:check_process_code(self(), my_code_test), - 4 = MyFun(1, 2), - t_check_process_code2(Code, Fakes). - -t_check_process_code2(Code, _) -> - false = erlang:check_process_code(self(), my_code_test), - true = erlang:purge_module(my_code_test), - - %% In the next test we will load the same module twice. - {module,my_code_test} = code:load_abs(Code), - F = my_code_test:make_fun(37), - 2 = fun_refc(F), - false = erlang:check_process_code(self(), my_code_test), - {module,my_code_test} = code:load_abs(Code), - 2 = fun_refc(F), - - %% Still false because the fun with the same identify is found - %% in the current code. - false = erlang:check_process_code(self(), my_code_test), - - %% Some fake funs in the same module should not do any difference. - false = erlang:check_process_code(self(), my_code_test), - - 38 = F(1), - t_check_process_code3(Code, F, []). + File1 = filename:join(Data, "my_code_test"), + File2 = filename:join(Data, "my_code_test2"), + + {ok,my_code_test} = c:c(File1, [{outdir,Priv}]), + {ok,my_code_test2} = c:c(File2, [{outdir,Priv}]), + erlang:delete_module(my_code_test), + erlang:delete_module(my_code_test2), -t_check_process_code3(Code, F, Fakes) -> - Pid = spawn_link(fun() -> body(F, Fakes) end), - true = erlang:purge_module(my_code_test), - false = erlang:check_process_code(self(), my_code_test), - false = erlang:check_process_code(Pid, my_code_test), + Self = self(), - true = erlang:delete_module(my_code_test), - true = erlang:check_process_code(self(), my_code_test), - true = erlang:check_process_code(Pid, my_code_test), - 39 = F(2), - t_check_process_code4(Code, Pid). - -t_check_process_code4(_Code, Pid) -> - Pid ! drop_funs, - receive after 1 -> ok end, - false = erlang:check_process_code(Pid, my_code_test), + Fun1 = fun () -> + erts_code_purger:purge(my_code_test), + Self ! {self(), done} + end, + Fun2 = fun () -> + erts_code_purger:soft_purge(my_code_test2), + Self ! {self(), done} + end, + Fun3 = fun () -> + erts_code_purger:purge('__nonexisting_module__'), + Self ! {self(), done} + end, + Fun4 = fun () -> + erts_code_purger:soft_purge('__another_nonexisting_module__'), + Self ! {self(), done} + end, + + Pid1 = spawn_link(Fun1), + Pid2 = spawn_link(Fun2), + Pid3 = spawn_link(Fun3), + Pid4 = spawn_link(Fun4), + Pid5 = spawn_link(Fun1), + Pid6 = spawn_link(Fun2), + Pid7 = spawn_link(Fun3), + receive after 50 -> ok end, + Pid8 = spawn_link(Fun4), + Pid9 = spawn_link(Fun1), + Pid10 = spawn_link(Fun2), + Pid11 = spawn_link(Fun3), + Pid12 = spawn_link(Fun4), + Pid13 = spawn_link(Fun1), + receive after 50 -> ok end, + Pid14 = spawn_link(Fun2), + Pid15 = spawn_link(Fun3), + Pid16 = spawn_link(Fun4), + + lists:foreach(fun (P) -> receive {P, done} -> ok end end, + [Pid1, Pid2, Pid3, Pid4, Pid5, Pid6, Pid7, Pid8, + Pid9, Pid10, Pid11, Pid12, Pid13, Pid14, Pid15, Pid16]), ok. body(F, Fakes) -> @@ -388,72 +353,6 @@ gc() -> gc1(). gc1() -> ok. -%% Test check_process_code/2 in combination with a fun obtained from an ets table. -t_check_process_code_ets(Config) when is_list(Config) -> - case check_process_code_handle(indirect_references) of - false -> - {skipped, "check_process_code() ignores funs"}; - true -> - case test_server:is_native(?MODULE) of - true -> - {skip,"Native code"}; - false -> - do_check_process_code_ets(Config) - end - end. - -do_check_process_code_ets(Config) -> - Priv = proplists:get_value(priv_dir, Config), - Data = proplists:get_value(data_dir, Config), - File = filename:join(Data, "my_code_test"), - - catch erlang:purge_module(my_code_test), - catch erlang:delete_module(my_code_test), - catch erlang:purge_module(my_code_test), - {ok,my_code_test} = c:c(File, [{outdir,Priv}]), - - T = ets:new(my_code_test, []), - ets:insert(T, {7,my_code_test:make_fun(107)}), - ets:insert(T, {8,my_code_test:make_fun(108)}), - erlang:delete_module(my_code_test), - false = erlang:check_process_code(self(), my_code_test), - Body = fun() -> - [{7,F1}] = ets:lookup(T, 7), - [{8,F2}] = ets:lookup(T, 8), - IdleLoop = fun() -> receive _X -> ok end end, - RecLoop = fun(Again) -> - receive - call -> 110 = F1(3), - 100 = F2(-8), - Again(Again); - {drop_funs,To} -> - To ! funs_dropped, - IdleLoop() - end - end, - true = erlang:check_process_code(self(), my_code_test), - RecLoop(RecLoop) - end, - Pid = spawn_link(Body), - receive after 1 -> ok end, - true = erlang:check_process_code(Pid, my_code_test), - Pid ! call, - Pid ! {drop_funs,self()}, - - receive - funs_dropped -> ok; - Other -> ct:fail({unexpected,Other}) - after 10000 -> - ct:fail(no_funs_dropped_answer) - end, - - false = erlang:check_process_code(Pid, my_code_test), - ok. - -fun_refc(F) -> - {refc,Count} = erlang:fun_info(F, refc), - Count. - %% Test the erlang:check_old_code/1 BIF. t_check_old_code(Config) when is_list(Config) -> @@ -1137,9 +1036,6 @@ flush() -> id(I) -> I. -check_process_code_handle(What) -> - lists:member(What, erlang:system_info(check_process_code)). - wait_until(Fun) -> case Fun() of true -> diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl index 8a600b7d9f..35dd147550 100644 --- a/erts/emulator/test/gc_SUITE.erl +++ b/erts/emulator/test/gc_SUITE.erl @@ -23,15 +23,26 @@ -module(gc_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("eunit/include/eunit.hrl"). + -export([all/0, suite/0]). --export([grow_heap/1, grow_stack/1, grow_stack_heap/1, max_heap_size/1]). +-export([ + grow_heap/1, + grow_stack/1, + grow_stack_heap/1, + max_heap_size/1, + minor_major_gc_option_async/1, + minor_major_gc_option_self/1 +]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [grow_heap, grow_stack, grow_stack_heap, max_heap_size]. + [grow_heap, grow_stack, grow_stack_heap, max_heap_size, + minor_major_gc_option_self, + minor_major_gc_option_async]. %% Produce a growing list of elements, @@ -190,3 +201,91 @@ long_receive() -> after 10000 -> ok end. + +minor_major_gc_option_self(_Config) -> + Endless = fun Endless() -> + receive + {gc, Type} -> erlang:garbage_collect(self(), [{type, Type}]) + after 100 -> ok end, + Endless() + end, + + %% Try as major, a test process will self-trigger GC + P1 = spawn(Endless), + erlang:garbage_collect(P1, []), + erlang:trace(P1, true, [garbage_collection]), + P1 ! {gc, major}, + expect_trace_messages(P1, [gc_major_start, gc_major_end]), + erlang:trace(P1, false, [garbage_collection]), + erlang:exit(P1, kill), + + %% Try as minor, a test process will self-trigger GC + P2 = spawn(Endless), + erlang:garbage_collect(P2, []), + erlang:trace(P2, true, [garbage_collection]), + P2 ! {gc, minor}, + expect_trace_messages(P2, [gc_minor_start, gc_minor_end]), + erlang:trace(P2, false, [garbage_collection]), + erlang:exit(P2, kill). + +minor_major_gc_option_async(_Config) -> + Endless = fun Endless() -> + receive after 100 -> ok end, + Endless() + end, + + %% Try with default option, must be major gc + P1 = spawn(Endless), + erlang:garbage_collect(P1, []), + erlang:trace(P1, true, [garbage_collection]), + erlang:garbage_collect(P1, []), + expect_trace_messages(P1, [gc_major_start, gc_major_end]), + erlang:trace(P1, false, [garbage_collection]), + erlang:exit(P1, kill), + + %% Try with the 'major' type + P2 = spawn(Endless), + erlang:garbage_collect(P2, []), + erlang:trace(P2, true, [garbage_collection]), + erlang:garbage_collect(P2, [{type, major}]), + expect_trace_messages(P2, [gc_major_start, gc_major_end]), + erlang:trace(P2, false, [garbage_collection]), + erlang:exit(P2, kill), + + %% Try with 'minor' option, once + P3 = spawn(Endless), + erlang:garbage_collect(P3, []), + erlang:trace(P3, true, [garbage_collection]), + erlang:garbage_collect(P3, [{type, minor}]), + expect_trace_messages(P3, [gc_minor_start, gc_minor_end]), + erlang:trace(P3, false, [garbage_collection]), + erlang:exit(P3, kill), + + %% Try with 'minor' option, once, async + P4 = spawn(Endless), + Ref = erlang:make_ref(), + erlang:garbage_collect(P4, []), + erlang:trace(P4, true, [garbage_collection]), + ?assertEqual(async, + erlang:garbage_collect(P4, [{type, minor}, {async, Ref}])), + expect_trace_messages(P4, [gc_minor_start, gc_minor_end]), + erlang:trace(P4, false, [garbage_collection]), + receive {garbage_collect, Ref, true} -> ok; + Other4 -> ct:pal("Unexpected message: ~p~n" + ++ "while waiting for async gc result", [Other4]) + after 2000 -> ?assert(false) + end, + erlang:exit(P4, kill). + +%% Given a list of atoms, trace tags - receives messages and checks if they are +%% trace events, and if the tag matches. Else will crash failing the test. +expect_trace_messages(_Pid, []) -> ok; +expect_trace_messages(Pid, [Tag | TraceTags]) -> + receive + {trace, Pid, Tag, _Data} -> ok; + AnythingElse -> + ct:pal("Unexpected message: ~p~nWhile expected {trace, _, ~p, _}", + [AnythingElse, Tag]), + ?assert(false) + end, + expect_trace_messages(Pid, TraceTags). diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 6733237b20..34e956bc21 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -427,13 +427,13 @@ silent_no_ms(Config) when is_list(Config) -> %% [{trace,Tracee,call,{?MODULE,f1,[start]}}, {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, {trace,Tracee,call,{?MODULE,f2,[f,g]}}, {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, {trace,Tracee,call,{erlang,integer_to_list,[2]}}, {trace,Tracee,return_to, - {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {?MODULE,'-silent_no_ms/1-fun-3-',0}}, {trace,Tracee,call,{?MODULE,f2,[h,i]}}, {trace,Tracee,return_to,{?MODULE,f3,2}}] end). @@ -484,7 +484,7 @@ ms_trace2(Config) when is_list(Config) -> %% %% Expected: (no return_to for global call trace) %% - Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1}, + Origin = {match_spec_SUITE,'-ms_trace2/1-fun-1-',1}, [{trace_ts,Tracee,call, {?MODULE,fn, [[all],[call,return_to,{tracer,Tracer}]]}, @@ -574,7 +574,7 @@ ms_trace3(Config) when is_list(Config) -> %% %% Expected: (no return_to for global call trace) %% - Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2}, + Origin = {match_spec_SUITE,'-ms_trace3/1-fun-2-',2}, [{trace_ts,Controller,call, {?MODULE,fn,[TraceeName,[all], [call,return_to,send,'receive', diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index d1c9648017..1a1ab0e5e0 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -32,6 +32,8 @@ %% list_to_integer/1 %% round/1 %% trunc/1 +%% floor/1 +%% ceil/1 %% integer_to_binary/1 %% integer_to_binary/2 %% binary_to_integer/1 @@ -41,7 +43,7 @@ t_float_to_string/1, t_integer_to_string/1, t_string_to_integer/1, t_list_to_integer_edge_cases/1, t_string_to_float_safe/1, t_string_to_float_risky/1, - t_round/1, t_trunc/1 + t_round/1, t_trunc_and_friends/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -49,7 +51,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [t_abs, t_float, t_float_to_string, t_integer_to_string, {group, t_string_to_float}, t_string_to_integer, t_round, - t_trunc, t_list_to_integer_edge_cases]. + t_trunc_and_friends, t_list_to_integer_edge_cases]. groups() -> [{t_string_to_float, [], @@ -295,30 +297,78 @@ t_round(Config) when is_list(Config) -> -4294967297 = -round(id(4294967296.9)), ok. -t_trunc(Config) when is_list(Config) -> - 0 = trunc(id(0.0)), - 5 = trunc(id(5.3333)), - -10 = trunc(id(-10.978987)), +%% Test trunc/1, floor/1, ceil/1, and round/1. +t_trunc_and_friends(_Config) -> + MinusZero = 0.0 / (-1.0), + 0 = trunc_and_friends(MinusZero), + 0 = trunc_and_friends(0.0), + 5 = trunc_and_friends(5.3333), + -10 = trunc_and_friends(-10.978987), - % The largest smallnum, converted to float (OTP-3722): + %% The largest smallnum, converted to float (OTP-3722): X = id((1 bsl 27) - 1), - F = id(X + 0.0), + F = X + 0.0, io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", [X, X, binary_to_list(term_to_binary(X)), F, F, binary_to_list(term_to_binary(F)), - trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), - X = trunc(F), - X = trunc(F+1)-1, - X = trunc(F-1)+1, - X = -trunc(-F), - X = -trunc(-F-1)-1, - X = -trunc(-F+1)+1, + trunc_and_friends(F), + trunc_and_friends(F), + binary_to_list(term_to_binary(trunc_and_friends(F)))]), + X = trunc_and_friends(F), + X = trunc_and_friends(F+1)-1, + X = trunc_and_friends(F-1)+1, + X = -trunc_and_friends(-F), + X = -trunc_and_friends(-F-1)-1, + X = -trunc_and_friends(-F+1)+1, %% Bignums. - 4294967305 = trunc(id(4294967305.7)), - -4294967305 = trunc(id(-4294967305.7)), + 4294967305 = trunc_and_friends(4294967305.7), + -4294967305 = trunc_and_friends(-4294967305.7), + 18446744073709551616 = trunc_and_friends(float(1 bsl 64)), + -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)), + + %% Random. + t_trunc_and_friends_rand(100), ok. +t_trunc_and_friends_rand(0) -> + ok; +t_trunc_and_friends_rand(N) -> + F0 = rand:uniform() * math:pow(10, 50*rand:normal()), + F = case rand:uniform() of + U when U < 0.5 -> -F0; + _ -> F0 + end, + _ = trunc_and_friends(F), + t_trunc_and_friends_rand(N-1). + +trunc_and_friends(F) -> + Trunc = trunc(F), + Floor = floor(F), + Ceil = ceil(F), + Round = round(F), + + Trunc = trunc(Trunc), + Floor = floor(Floor), + Ceil = ceil(Ceil), + Round = round(Round), + + Trunc = trunc(float(Trunc)), + Floor = floor(float(Floor)), + Ceil = ceil(float(Ceil)), + Round = round(float(Round)), + + true = Floor =< Trunc andalso Trunc =< Ceil, + true = Ceil - Floor =< 1, + true = Round =:= Floor orelse Round =:= Ceil, + + if + F < 0 -> + Trunc = Ceil; + true -> + Trunc = Floor + end, + Trunc. %% Tests integer_to_binary/1. diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 0f999e0efe..e035fc64fe 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -2428,7 +2428,7 @@ no_priority_inversion2(Config) when is_list(Config) -> request_gc(Pid, Prio) -> Ref = make_ref(), - erts_internal:request_system_task(Pid, Prio, {garbage_collect, Ref}), + erts_internal:request_system_task(Pid, Prio, {garbage_collect, Ref, major}), Ref. system_task_blast(Config) when is_list(Config) -> diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 4407f7e289..9813142585 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -475,7 +475,7 @@ sub emulator_output { print '#include "beam_load.h"', "\n"; print "\n"; - print "char tag_to_letter[] = {\n "; + print "const char tag_to_letter[] = {\n "; for ($i = 0; $i < length($genop_types); $i++) { print "'$tag_type[$i]', "; } @@ -489,7 +489,7 @@ sub emulator_output { # Generate code for specific ops. # my($spec_opnum) = 0; - print "OpEntry opc[] = {\n"; + print "const OpEntry opc[] = {\n"; foreach $key (sort keys %specific_op) { $gen_to_spec{$key} = $spec_opnum; $num_specific{$key} = @{$specific_op{$key}}; @@ -566,13 +566,22 @@ sub emulator_output { $sep = ","; } $init .= "}"; - init_item($print_name, $init, $involves_r, $size, $pack, $sign, 0); + init_item($print_name, $init, $involves_r, $size, $pack, $sign); $op_to_name[$spec_opnum] = $instr; $spec_opnum++; } } print "};\n\n"; - print "int num_instructions = $spec_opnum;\n\n"; + print "const int num_instructions = $spec_opnum;\n\n"; + + # + # Print the array for instruction counts. + # + + print "#ifdef ERTS_OPCODE_COUNTER_SUPPORT\n"; + print "Uint erts_instr_count[$spec_opnum];\n"; + print "#endif\n"; + print "\n"; # # Generate transformations. @@ -584,7 +593,7 @@ sub emulator_output { # Print the generic instruction table. # - print "GenOpEntry gen_opc[] = {\n"; + print "const GenOpEntry gen_opc[] = {\n"; for ($i = 0; $i < @gen_opname; $i++) { if ($i == $num_file_opcodes) { print "\n/*\n * Internal generic instructions.\n */\n\n"; @@ -678,8 +687,8 @@ sub emulator_output { print "#define TE_MAX_VARS $te_max_vars\n"; print "\n"; - print "extern char tag_to_letter[];\n"; - print "extern Uint op_transform[];\n"; + print "extern const char tag_to_letter[];\n"; + print "extern const Uint op_transform[];\n"; print "\n"; for ($i = 0; $i < @op_to_name; $i++) { @@ -708,7 +717,7 @@ sub emulator_output { print "#define DEFINE_COUNTING_LABELS"; for ($i = 0; $i < @op_to_name; $i++) { my($name) = $op_to_name[$i]; - print " \\\nCountCase($name): opc[$i].count++; goto lb_$name;"; + print " \\\nCountCase($name): erts_instr_count[$i]++; goto lb_$name;"; } print "\n\n"; @@ -1417,7 +1426,7 @@ sub tr_gen { # Print the generated transformation engine. # my($offset) = 0; - print "Uint op_transform[] = {\n"; + print "const Uint op_transform[] = {\n"; foreach $key (sort keys %gen_transform) { $gen_transform_offset{$key} = $offset; my @instr = @{$gen_transform{$key}}; diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload index f489bc2a39..8b629d9517 100755 --- a/erts/emulator/utils/make_preload +++ b/erts/emulator/utils/make_preload @@ -94,8 +94,8 @@ foreach $file (@ARGV) { close(FILE); push(@modules, " {\"$module\", " . length($_) . ", preloaded_$module},\n"); - print "unsigned preloaded_size_$module = ", length($_), ";\n"; - print "unsigned char preloaded_$module", "[] = {\n"; + print "const unsigned preloaded_size_$module = ", length($_), ";\n"; + print "const unsigned char preloaded_$module", "[] = {\n"; for ($i = 0; $i < length($_); $i++) { if ($i % 8 == 0 && $comment ne '') { $comment =~ s@/\*@..@g; # Comment start -- avoid warning. @@ -125,10 +125,10 @@ if ($gen_rc) { print @modules; print "END\n"; } elsif ($gen_old) { - print "struct {\n"; + print "const struct {\n"; print " char* name;\n"; print " int size;\n"; - print " unsigned char* code;\n"; + print " const unsigned char* code;\n"; print "} pre_loaded[] = {\n"; foreach (@modules) { print; diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index c158778f43..27f9dcc878 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -36,7 +36,6 @@ use File::Basename; # <-src>/erl_am.c # <-src>/erl_bif_table.c # <-src>/erl_bif_wrap.c -# <-src>/erl_pbifs.c # <-include>/erl_atom_table.h # <-include>/erl_bif_table.h # @@ -54,8 +53,7 @@ my %aliases; my $auto_alias_num = 0; my @bif; -my @implementation; -my @pbif; +my @bif_type; while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { my $opt = shift; @@ -79,8 +77,11 @@ while (<>) { my($type, @args) = split; if ($type eq 'atom') { save_atoms(@args); - } elsif ($type eq 'bif' or $type eq 'ubif') { - my($bif,$alias,$alias2) = (@args); + } elsif ($type eq 'bif' or $type eq 'ubif' or $type eq 'gcbif') { + if (@args > 2) { + error("$type only allows two arguments"); + } + my($bif,$alias) = (@args); $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); my($mod,$name,$arity) = ($1,$2,$3); save_atoms($mod, $name); @@ -90,12 +91,14 @@ while (<>) { $alias .= "${name}_$arity"; } my $wrapper; - $wrapper = "wrap_$alias" if $type eq 'bif'; - $wrapper = $alias if $type eq 'ubif'; + if ($type eq 'bif') { + $wrapper = "wrap_$alias"; + } else { + $wrapper = $alias; + } push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity, $alias,$wrapper]); - push(@pbif, $bif =~ m/^'/ && $alias =~ m/^ebif_/); - push(@implementation, $alias2); + push(@bif_type, $type); } else { error("invalid line"); } @@ -166,8 +169,14 @@ typedef struct bif_entry { BifFunction traced; } BifEntry; +typedef struct erts_gc_bif { + BifFunction bif; + BifFunction gc_bif; +} ErtsGcBif; + extern BifEntry bif_table[]; extern Export* bif_export[]; +extern const ErtsGcBif erts_gc_bifs[]; #define BIF_SIZE $bif_size @@ -182,8 +191,12 @@ print "\n"; for ($i = 0; $i < @bif; $i++) { my $args = join(', ', 'Process*', 'Eterm*'); - print "Eterm $bif[$i]->[3]($args);\n"; - print "Eterm wrap_$bif[$i]->[3]($args, UWord *I);\n"; + my $name = $bif[$i]->[3]; + print "Eterm $name($args);\n"; + print "Eterm wrap_$name($args, UWord *I);\n"; + print "Eterm erts_gc_$name(Process* p, Eterm* reg, Uint live);\n" + if $bif_type[$i] eq 'gcbif'; + print "\n"; } print "#endif\n"; @@ -225,27 +238,26 @@ for ($i = 0; $i < @bif; $i++) { } # -# Generate the package bif file. +# Generate erl_gc_bifs.c. # -open_file("$src/erl_pbifs.c"); +open_file("$src/erl_gc_bifs.c"); my $i; includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", - "erl_bif_table.h", "erl_atom_table.h"); + "erl_bif_table.h"); +print "const ErtsGcBif erts_gc_bifs[] = {\n"; for ($i = 0; $i < @bif; $i++) { + next unless $bif_type[$i] eq 'gcbif'; my $arity = $bif[$i]->[2]; my $func = $bif[$i]->[3]; - my $arg; - next unless $pbif[$i]; - next unless $func =~ m/^ebif_(.*)/; - my $orig_func = $1; - $orig_func = $implementation[$i] if $implementation[$i]; - print "Eterm\n"; - print "$func(Process* p, Eterm* BIF__ARGS)\n"; - print "{\n"; - print " return $orig_func(p, BIF__ARGS);\n"; - print "}\n\n"; + print " {$func, erts_gc_$func},\n"; } +print " {0, 0}\n"; +print "};\n"; + +# +# Utilities follow. +# sub open_file { # or die my($name) = @_; |