diff options
Diffstat (limited to 'erts/emulator')
44 files changed, 2967 insertions, 2731 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 67320697ef..3e44bbb8db 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -61,7 +61,7 @@ else ifeq ($(TYPE),purify) PURIFY = purify $(PURIFY_BUILD_OPTIONS) TYPEMARKER = .purify -TYPE_FLAGS = $(DEBUG_CFLAGS) -DPURIFY -DNO_JUMP_TABLE -DERTS_MSEG_FAKE_SEGMENTS +TYPE_FLAGS = $(DEBUG_CFLAGS) -DPURIFY -DNO_JUMP_TABLE ENABLE_ALLOC_TYPE_VARS += purify else @@ -92,7 +92,7 @@ else ifeq ($(TYPE),valgrind) PURIFY = TYPEMARKER = .valgrind -TYPE_FLAGS = $(DEBUG_CFLAGS) -DVALGRIND -DNO_JUMP_TABLE -DERTS_MSEG_FAKE_SEGMENTS +TYPE_FLAGS = $(DEBUG_CFLAGS) -DVALGRIND -DNO_JUMP_TABLE ENABLE_ALLOC_TYPE_VARS += valgrind else @@ -399,7 +399,7 @@ include zlib/zlib.mk include pcre/pcre.mk $(ERTS_LIB): - cd $(ERTS_LIB_DIR) && $(MAKE) $(TYPE) + $(V_at)cd $(ERTS_LIB_DIR) && $(MAKE) $(TYPE) .PHONY: clean clean: @@ -491,7 +491,7 @@ $(TTF_DIR)/beam_pred_funcs.h \ $(TTF_DIR)/beam_tr_funcs.h \ : $(TTF_DIR)/OPCODES-GENERATED $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops - LANG=C $(PERL) utils/beam_makeops \ + $(gen_verbose)LANG=C $(PERL) utils/beam_makeops \ -wordsize @EXTERNAL_WORD_SIZE@ \ -outdir $(TTF_DIR) \ -DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \ @@ -525,22 +525,22 @@ $(TARGET)/erl_atom_table.h \ $(TARGET)/erl_pbifs.c \ : $(TARGET)/TABLES-GENERATED $(TARGET)/TABLES-GENERATED: $(ATOMS) $(BIFS) utils/make_tables - LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ + $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ $(ATOMS) $(BIFS) && echo $? >$(TARGET)/TABLES-GENERATED GENERATE += $(TARGET)/TABLES-GENERATED $(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types - LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS) + $(gen_verbose)LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS) GENERATE += $(TTF_DIR)/erl_alloc_types.h # version include file $(TARGET)/erl_version.h: ../vsn.mk - LANG=C $(PERL) utils/make_version -o $@ $(SYSTEM_VSN) $(VSN)$(SERIALNO) $(TARGET) + $(gen_verbose)LANG=C $(PERL) utils/make_version -o $@ $(SYSTEM_VSN) $(VSN)$(SERIALNO) $(TARGET) GENERATE += $(TARGET)/erl_version.h # driver table $(TTF_DIR)/driver_tab.c: Makefile.in - LANG=C $(PERL) utils/make_driver_tab -o $@ $(DRV_OBJS) + $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ $(DRV_OBJS) GENERATE += $(TTF_DIR)/driver_tab.c @@ -562,7 +562,7 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam - LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@ + $(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@ else PRELOAD_OBJ = $(OBJDIR)/preload.o PRELOAD_SRC = $(TARGET)/preload.c @@ -575,7 +575,7 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam - LANG=C $(PERL) utils/make_preload -old $^ > $@ + $(gen_verbose)LANG=C $(PERL) utils/make_preload -old $^ > $@ endif .PHONY : generate @@ -586,13 +586,13 @@ else generate: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(TTF_DIR)/GENERATED: $(GENERATE) - echo $? >$(TTF_DIR)/GENERATED + $(gen_verbose)echo $? >$(TTF_DIR)/GENERATED endif $(TARGET)/erlang_dtrace.h: beam/erlang_dtrace.d - dtrace -h -C -Ibeam -s $< -o ./erlang_dtrace.tmp - sed -e '/^#define[ ]*ERLANG_[A-Z0-9_]*(.*)/y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/' ./erlang_dtrace.tmp > $@ - rm ./erlang_dtrace.tmp + $(dtrace_verbose)dtrace -h -C -Ibeam -s $< -o ./erlang_dtrace.tmp + $(V_at)sed -e '/^#define[ ]*ERLANG_[A-Z0-9_]*(.*)/y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/' ./erlang_dtrace.tmp > $@ + $(V_at)rm ./erlang_dtrace.tmp # ---------------------------------------------------------------------- # Pattern rules @@ -613,45 +613,45 @@ endif ifeq ($(TARGET),win32) $(OBJDIR)/dll_sys.o: sys/$(ERLANG_OSTYPE)/sys.c - $(CC) $(CFLAGS) -DERL_RUN_SHARED_LIB=1 $(INCLUDES) -c $< -o $@ + $(V_CC) $(CFLAGS) -DERL_RUN_SHARED_LIB=1 $(INCLUDES) -c $< -o $@ $(OBJDIR)/beams.$(RES_EXT): $(TARGET)/beams.rc - $(RC) -o $@ -I$(ERL_TOP)/erts/etc/win32 $(TARGET)/beams.rc + $(V_RC) -o $@ -I$(ERL_TOP)/erts/etc/win32 $(TARGET)/beams.rc endif ifneq ($(filter tile-%,$(TARGET)),) $(OBJDIR)/beam_emu.o: beam/beam_emu.c - $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) \ + $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) \ -OPT:Olimit=0 -WOPT:lpre=off:spre=off:epre=off \ $(INCLUDES) -c $< -o $@ else # Usually the same as the default rule, but certain platforms (e.g. win32) mix # different compilers $(OBJDIR)/beam_emu.o: beam/beam_emu.c - $(EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ endif $(OBJDIR)/%.o: beam/%.c - $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.o: $(TARGET)/%.c - $(CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -c $< -o $@ + $(V_CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -c $< -o $@ $(OBJDIR)/%.o: $(TTF_DIR)/%.c - $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.o: sys/$(ERLANG_OSTYPE)/%.c - $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.o: sys/common/%.c - $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.o: drivers/common/%.c - $(CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -c $< -o $@ + $(V_CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -c $< -o $@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c - $(CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@ + $(V_CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@ # ---------------------------------------------------------------------- # Specials @@ -659,19 +659,19 @@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c CS_SRC = sys/$(ERLANG_OSTYPE)/erl_child_setup.c $(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_SRC) $(ERTS_LIB) - $(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ + $(ld_verbose)$(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_SRC) $(CS_LIBS) $(OBJDIR)/%.kp.o: sys/common/%.c - $(CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.nkp.o: sys/common/%.c - $(CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ ifeq ($(GCC),yes) $(OBJDIR)/erl_goodfit_alloc.o: beam/erl_goodfit_alloc.c - $(CC) $(subst -O2, $(GEN_OPT_FLGS) $(UNROLL_FLG), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_CC) $(subst -O2, $(GEN_OPT_FLGS) $(UNROLL_FLG), $(CFLAGS)) $(INCLUDES) -c $< -o $@ endif # ---------------------------------------------------------------------- @@ -844,28 +844,28 @@ $(OBJS): $(TTF_DIR)/GENERATED M4FLAGS += -DTARGET=$(TARGET) -DOPSYS=$(OPSYS) -DARCH=$(ARCH) $(TTF_DIR)/%.S: hipe/%.m4 - m4 $(M4FLAGS) $< > $@ + $(m4_verbose)m4 $(M4FLAGS) $< > $@ $(TTF_DIR)/%.h: hipe/%.m4 - m4 $(M4FLAGS) $< > $@ + $(m4_verbose)m4 $(M4FLAGS) $< > $@ $(OBJDIR)/%.o: $(TTF_DIR)/%.S - $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.o: hipe/%.S - $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ $(OBJDIR)/%.o: hipe/%.c - $(CC) $(subst O2,O3, $(CFLAGS)) $(INCLUDES) -c $< -o $@ + $(V_CC) $(subst O2,O3, $(CFLAGS)) $(INCLUDES) -c $< -o $@ $(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o - $(CC) $(CFLAGS) $(INCLUDES) -o $@ $< + $(ld_verbose)$(CC) $(CFLAGS) $(INCLUDES) -o $@ $< $(OBJDIR)/hipe_mkliterals.o: $(HIPE_ASM) $(TTF_DIR)/erl_alloc_types.h \ $(TTF_DIR)/OPCODES-GENERATED $(TARGET)/TABLES-GENERATED $(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER) - $(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@ + $(gen_verbose)$(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@ $(OBJDIR)/hipe_x86_glue.o: hipe/hipe_x86_glue.S \ $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_literals.h \ @@ -908,7 +908,7 @@ $(OBJDIR)/hipe_arm_bifs.o: $(TTF_DIR)/hipe_arm_bifs.S \ # Use -fomit-frame-pointer to work around gcc (v4.5.2) bug causing # "error: r7 cannot be used in asm here" for DEBUG build. $(OBJDIR)/hipe_arm.o: hipe/hipe_arm.c - $(CC) $(subst O2,O3, $(CFLAGS)) -fomit-frame-pointer $(INCLUDES) -c $< -o $@ + $(V_CC) $(subst O2,O3, $(CFLAGS)) -fomit-frame-pointer $(INCLUDES) -c $< -o $@ # end of HiPE section ######################################## @@ -919,13 +919,13 @@ $(OBJDIR)/hipe_arm.o: hipe/hipe_arm.c ifeq ($(TARGET), win32) # Only the basic erlang to begin with eh? $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) - $(PURIFY) $(LD) -dll -def:sys/$(ERLANG_OSTYPE)/erl.def -implib:$(BINDIR)/erl_dll.lib -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ + $(ld_verbose)$(PURIFY) $(LD) -dll -def:sys/$(ERLANG_OSTYPE)/erl.def -implib:$(BINDIR)/erl_dll.lib -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) $(LIBS) else $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) - $(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ + $(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ $(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) $(LIBS) endif @@ -1013,23 +1013,24 @@ depend: else depend: $(TTF_DIR)/depend.mk $(TTF_DIR)/depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) - $(DEP_CC) $(DEP_FLAGS) $(BEAM_SRC) \ + $(gen_verbose) + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(BEAM_SRC) \ | $(SED_DEPEND) > $(TTF_DIR)/depend.mk - $(DEP_CC) $(DEP_FLAGS) -DLIBSCTP=$(LIBSCTP) $(DRV_COMMON_SRC) \ + $(V_at)$(DEP_CC) $(DEP_FLAGS) -DLIBSCTP=$(LIBSCTP) $(DRV_COMMON_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk - $(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \ + $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk - $(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk - $(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk - $(DEP_CC) $(DEP_FLAGS) $(ZLIB_SRC) \ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(ZLIB_SRC) \ | $(SED_DEPEND_ZLIB) >> $(TTF_DIR)/depend.mk ifdef HIPE_ENABLED - $(DEP_CC) $(DEP_FLAGS) $(HIPE_SRC) \ + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(HIPE_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk endif - cd $(ERTS_LIB_DIR) && $(MAKE) depend + $(V_at)cd $(ERTS_LIB_DIR) && $(MAKE) depend endif ifneq ($(MAKECMDGOALS),clean) diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 2168d410b5..c1e11f6448 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -65,10 +65,10 @@ #define ERTS_BPF_ALL 0xFF -extern Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ -extern Eterm beam_return_trace[1]; /* OpCode(i_return_trace) */ -extern Eterm beam_exception_trace[1]; /* OpCode(i_exception_trace) */ -extern Eterm beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ +extern BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ +extern BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */ +extern BeamInstr beam_exception_trace[1]; /* OpCode(i_exception_trace) */ +extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ erts_smp_atomic32_t erts_active_bp_index; erts_smp_atomic32_t erts_staging_bp_index; @@ -161,7 +161,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified) for (current = 0; current < num_modules; current++) { BeamInstr** code_base = (BeamInstr **) module[current]->curr.code; BeamInstr* code; - Uint num_functions = (Uint) code_base[MI_NUM_FUNCTIONS]; + Uint num_functions = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS]; Uint fi; if (specified > 0) { @@ -172,7 +172,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified) } for (fi = 0; fi < num_functions; fi++) { - Eterm* pc; + BeamInstr* pc; int wi; code = code_base[MI_FUNCTIONS+fi]; @@ -555,7 +555,7 @@ erts_clear_module_break(Module *modp) { if (code_base == NULL) { return 0; } - n = (Uint) code_base[MI_NUM_FUNCTIONS]; + n = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS]; for (i = 0; i < n; ++i) { BeamInstr* pc; @@ -919,7 +919,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, E -= 1; ASSERT(c_p->htop <= E && E <= c_p->hend); E[0] = make_cp(c_p->cp); - c_p->cp = (BeamInstr *) beam_return_to_trace; + c_p->cp = beam_return_to_trace; } if (flags & MATCH_SET_RX_TRACE) { E -= 3; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 98dc9a3902..97c8114437 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2421,9 +2421,7 @@ BIF_RETTYPE setelement_3(BIF_ALIST_3) /* copy the tuple */ resp = hp; - while (size--) { /* XXX use memcpy? */ - *hp++ = *ptr++; - } + sys_memcpy(hp, ptr, sizeof(Eterm)*size); resp[ix] = BIF_ARG_3; BIF_RET(make_tuple(resp)); } @@ -2436,7 +2434,7 @@ BIF_RETTYPE make_tuple_2(BIF_ALIST_2) Eterm* hp; Eterm res; - if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0) { + if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0 || n > ERTS_MAX_TUPLE_SIZE) { BIF_ERROR(BIF_P, BADARG); } hp = HAlloc(BIF_P, n+1); @@ -2457,7 +2455,7 @@ BIF_RETTYPE make_tuple_3(BIF_ALIST_3) Eterm list = BIF_ARG_3; Eterm* tup; - if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0) { + if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0 || n > ERTS_MAX_TUPLE_SIZE) { error: BIF_ERROR(BIF_P, BADARG); } @@ -2509,11 +2507,16 @@ BIF_RETTYPE append_element_2(BIF_ALIST_2) Eterm res; if (is_not_tuple(BIF_ARG_1)) { + error: BIF_ERROR(BIF_P, BADARG); } - ptr = tuple_val(BIF_ARG_1); + ptr = tuple_val(BIF_ARG_1); arity = arityval(*ptr); - hp = HAlloc(BIF_P, arity + 2); + + if (arity + 1 > ERTS_MAX_TUPLE_SIZE) + goto error; + + hp = HAlloc(BIF_P, arity + 2); res = make_tuple(hp); *hp = make_arityval(arity+1); while (arity--) { @@ -2523,6 +2526,78 @@ BIF_RETTYPE append_element_2(BIF_ALIST_2) BIF_RET(res); } +BIF_RETTYPE insert_element_3(BIF_ALIST_3) +{ + Eterm* ptr; + Eterm* hp; + Uint arity; + Eterm res; + Sint ix; + + if (is_not_tuple(BIF_ARG_2) || is_not_small(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + ptr = tuple_val(BIF_ARG_2); + arity = arityval(*ptr); + ix = signed_val(BIF_ARG_1); + + if ((ix < 1) || (ix > (arity + 1))) { + BIF_ERROR(BIF_P, BADARG); + } + + hp = HAlloc(BIF_P, arity + 1 + 1); + res = make_tuple(hp); + *hp = make_arityval(arity + 1); + + ix--; + arity -= ix; + + while (ix--) { *++hp = *++ptr; } + + *++hp = BIF_ARG_3; + + while(arity--) { *++hp = *++ptr; } + + BIF_RET(res); +} + +BIF_RETTYPE delete_element_2(BIF_ALIST_3) +{ + Eterm* ptr; + Eterm* hp; + Uint arity; + Eterm res; + Sint ix; + + if (is_not_tuple(BIF_ARG_2) || is_not_small(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + ptr = tuple_val(BIF_ARG_2); + arity = arityval(*ptr); + ix = signed_val(BIF_ARG_1); + + if ((ix < 1) || (ix > arity) || (arity == 0)) { + BIF_ERROR(BIF_P, BADARG); + } + + hp = HAlloc(BIF_P, arity + 1 - 1); + res = make_tuple(hp); + *hp = make_arityval(arity - 1); + + ix--; + arity -= ix; + + while (ix--) { *++hp = *++ptr; } + + ++ptr; + + while(arity--) { *++hp = *++ptr; } + + BIF_RET(res); +} + /**********************************************************************/ /* convert an atom to a list of ascii integer */ @@ -3097,7 +3172,7 @@ BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1) Eterm* hp; int len; - if ((len = list_length(list)) < 0) { + if ((len = list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) { BIF_ERROR(BIF_P, BADARG); } diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 9a1a25031c..59a91cd40c 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -31,219 +31,116 @@ # # Important: Use "ubif" for guard BIFs and operators; use "bif" for ordinary BIFs. # -# Add new BIFs to the end of the file. Do not bother adding a "packaged BIF name" -# (such as 'erl.lang.number'); if/when packages will be supported we will add -# all those names. +# 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). # ubif erlang:abs/1 -ubif 'erl.lang.number':abs/1 ebif_abs_1 bif erlang:adler32/1 -bif 'erl.util.crypt.adler32':sum/1 ebif_adler32_1 bif erlang:adler32/2 -bif 'erl.util.crypt.adler32':sum/2 ebif_adler32_2 bif erlang:adler32_combine/3 -bif 'erl.util.crypt.adler32':combine/3 ebif_adler32_combine_3 bif erlang:apply/3 -bif 'erl.lang':apply/3 ebif_apply_3 bif erlang:atom_to_list/1 -bif 'erl.lang.atom':to_string/1 ebif_atom_to_string_1 atom_to_list_1 bif erlang:binary_to_list/1 -bif 'erl.lang.binary':to_list/1 ebif_binary_to_list_1 bif erlang:binary_to_list/3 -bif 'erl.lang.binary':to_list/3 ebif_binary_to_list_3 bif erlang:binary_to_term/1 -bif 'erl.lang.binary':to_term/1 ebif_binary_to_term_1 bif erlang:check_process_code/2 -bif 'erl.system.code':check_process/2 ebif_check_process_code_2 bif erlang:crc32/1 -bif 'erl.util.crypt.crc32':sum/1 ebif_crc32_1 bif erlang:crc32/2 -bif 'erl.util.crypt.crc32':sum/2 ebif_crc32_2 bif erlang:crc32_combine/3 -bif 'erl.util.crypt.crc32':combine/3 ebif_crc32_combine_3 bif erlang:date/0 -bif 'erl.util.date':today/0 ebif_date_0 bif erlang:delete_module/1 -bif 'erl.system.code':delete/1 ebif_delete_module_1 bif erlang:display/1 -bif 'erl.system.debug':display/1 ebif_display_1 bif erlang:display_string/1 -bif 'erl.system.debug':display_string/1 ebif_display_string_1 bif erlang:display_nl/0 -bif 'erl.system.debug':display_nl/0 ebif_display_nl_0 ubif erlang:element/2 -ubif 'erl.lang.tuple':element/2 ebif_element_2 bif erlang:erase/0 -bif 'erl.lang.proc.pdict':erase/0 ebif_erase_0 bif erlang:erase/1 -bif 'erl.lang.proc.pdict':erase/1 ebif_erase_1 bif erlang:exit/1 -bif 'erl.lang':exit/1 ebif_exit_1 bif erlang:exit/2 -bif 'erl.lang.proc':signal/2 ebif_signal_2 exit_2 bif erlang:external_size/1 -bif 'erl.lang.term':external_size/1 ebif_external_size_1 bif erlang:external_size/2 -bif 'erl.lang.term':external_size/2 ebif_external_size_2 ubif erlang:float/1 -ubif 'erl.lang.number':to_float/1 ebif_to_float_1 float_1 bif erlang:float_to_list/1 -bif 'erl.lang.float':to_string/1 ebif_float_to_string_1 float_to_list_1 bif erlang:fun_info/2 -bif 'erl.lang.function':info/2 ebif_fun_info_2 bif erlang:garbage_collect/0 -bif 'erl.system':garbage_collect/0 ebif_garbage_collect_0 bif erlang:garbage_collect/1 -bif 'erl.system':garbage_collect/1 ebif_garbage_collect_1 bif erlang:get/0 -bif 'erl.lang.proc.pdict':get/0 ebif_get_0 bif erlang:get/1 -bif 'erl.lang.proc.pdict':get/1 ebif_get_1 bif erlang:get_keys/1 -bif 'erl.lang.proc.pdict':get_keys/1 ebif_get_keys_1 bif erlang:group_leader/0 -bif 'erl.lang.proc':group_leader/0 ebif_group_leader_0 bif erlang:group_leader/2 -bif 'erl.lang.proc':set_group_leader/2 ebif_group_leader_2 bif erlang:halt/0 -bif 'erl.lang.system':halt/0 ebif_halt_0 bif erlang:halt/1 -bif 'erl.lang.system':halt/1 ebif_halt_1 bif erlang:halt/2 -bif 'erl.lang.system':halt/2 ebif_halt_2 bif erlang:phash/2 bif erlang:phash2/1 bif erlang:phash2/2 -bif 'erl.lang.term':hash/1 ebif_phash2_1 -bif 'erl.lang.term':hash/2 ebif_phash2_2 ubif erlang:hd/1 -ubif 'erl.lang.list':hd/1 ebif_hd_1 bif erlang:integer_to_list/1 -bif 'erl.lang.integer':to_string/1 ebif_integer_to_string_1 integer_to_list_1 bif erlang:is_alive/0 -bif 'erl.lang.node':is_alive/0 ebif_is_alive_0 ubif erlang:length/1 -ubif 'erl.lang.list':length/1 ebif_length_1 bif erlang:link/1 -bif 'erl.lang.proc':link/1 ebif_link_1 bif erlang:list_to_atom/1 -bif 'erl.lang.atom':from_string/1 ebif_string_to_atom_1 list_to_atom_1 bif erlang:list_to_binary/1 -bif 'erl.lang.binary':from_list/1 ebif_list_to_binary_1 bif erlang:list_to_float/1 -bif 'erl.lang.float':from_string/1 ebif_string_to_float_1 list_to_float_1 bif erlang:list_to_integer/1 -bif 'erl.lang.integer':from_string/1 ebif_string_to_integer_1 list_to_integer_1 bif erlang:list_to_pid/1 -bif 'erl.lang.proc':string_to_pid/1 ebif_string_to_pid_1 list_to_pid_1 bif erlang:list_to_tuple/1 -bif 'erl.lang.tuple':from_list/1 ebif_list_to_tuple_1 bif erlang:loaded/0 -bif 'erl.system.code':loaded/0 ebif_loaded_0 bif erlang:localtime/0 -bif 'erl.util.date':local/0 ebif_localtime_0 bif erlang:localtime_to_universaltime/2 -bif 'erl.util.date':local_to_utc/2 ebif_localtime_to_universaltime_2 bif erlang:make_ref/0 -bif 'erl.lang.ref':new/0 ebif_make_ref_0 bif erlang:md5/1 -bif 'erl.util.crypt.md5':digest/1 ebif_md5_1 bif erlang:md5_init/0 -bif 'erl.util.crypt.md5':init/0 ebif_md5_init_0 bif erlang:md5_update/2 -bif 'erl.util.crypt.md5':update/2 ebif_md5_update_2 bif erlang:md5_final/1 -bif 'erl.util.crypt.md5':final/1 ebif_md5_final_1 bif erlang:module_loaded/1 -bif 'erl.system.code':is_loaded/1 ebif_is_loaded_1 module_loaded_1 bif erlang:function_exported/3 -bif 'erl.system.code':is_loaded/3 ebif_is_loaded_3 function_exported_3 bif erlang:monitor_node/2 -bif 'erl.lang.node':monitor/2 ebif_monitor_node_2 bif erlang:monitor_node/3 -bif 'erl.lang.node':monitor/3 ebif_monitor_node_3 ubif erlang:node/1 -ubif 'erl.lang.node':node/1 ebif_node_1 ubif erlang:node/0 -ubif 'erl.lang.node':node/0 ebif_node_0 bif erlang:nodes/1 -bif 'erl.lang.node':nodes/1 ebif_nodes_1 bif erlang:now/0 -bif 'erl.system':now/0 ebif_now_0 bif erlang:open_port/2 -bif 'erl.lang.port':open/2 ebif_open_port_2 open_port_2 bif erlang:pid_to_list/1 -bif 'erl.lang.proc':pid_to_string/1 ebif_pid_to_string_1 pid_to_list_1 bif erlang:ports/0 -bif 'erl.lang.node':ports/0 ebif_ports_0 bif erlang:pre_loaded/0 -bif 'erl.system.code':preloaded/0 ebif_pre_loaded_0 bif erlang:process_flag/2 -bif 'erl.lang.proc':set_flag/2 ebif_process_flag_2 bif erlang:process_flag/3 -bif 'erl.lang.proc':set_flag/3 ebif_process_flag_3 bif erlang:process_info/1 -bif 'erl.lang.proc':info/1 ebif_process_info_1 bif erlang:process_info/2 -bif 'erl.lang.proc':info/2 ebif_process_info_2 bif erlang:processes/0 -bif 'erl.lang.node':processes/0 ebif_processes_0 bif erlang:purge_module/1 -bif 'erl.system.code':purge/1 ebif_purge_module_1 bif erlang:put/2 -bif 'erl.lang.proc.pdict':put/2 ebif_put_2 bif erlang:register/2 -bif 'erl.lang.node':register/2 ebif_register_2 bif erlang:registered/0 -bif 'erl.lang.node':registered/0 ebif_registered_0 ubif erlang:round/1 -ubif 'erl.lang.number':round/1 ebif_round_1 ubif erlang:self/0 -ubif 'erl.lang.proc':self/0 ebif_self_0 bif erlang:setelement/3 -bif 'erl.lang.tuple':setelement/3 ebif_setelement_3 ubif erlang:size/1 -ubif 'erl.lang.term':size/1 ebif_size_1 bif erlang:spawn/3 -bif 'erl.lang.proc':spawn/3 ebif_spawn_3 bif erlang:spawn_link/3 -bif 'erl.lang.proc':spawn_link/3 ebif_spawn_link_3 bif erlang:split_binary/2 -bif 'erl.lang.binary':split/2 ebif_split_binary_2 bif erlang:statistics/1 -bif 'erl.system':statistics/1 ebif_statistics_1 bif erlang:term_to_binary/1 -bif 'erl.lang.binary':from_term/1 ebif_term_to_binary_1 bif erlang:term_to_binary/2 -bif 'erl.lang.binary':from_term/2 ebif_term_to_binary_2 bif erlang:throw/1 -bif 'erl.lang':throw/1 ebif_throw_1 bif erlang:time/0 -bif 'erl.util.date':time_of_day/0 ebif_time_0 ubif erlang:tl/1 -ubif 'erl.lang.list':tl/1 ebif_tl_1 ubif erlang:trunc/1 -ubif 'erl.lang.number':trunc/1 ebif_trunc_1 bif erlang:tuple_to_list/1 -bif 'erl.lang.tuple':to_list/1 ebif_tuple_to_list_1 bif erlang:universaltime/0 -bif 'erl.util.date':utc/0 ebif_universaltime_0 bif erlang:universaltime_to_localtime/1 -bif 'erl.util.date':utc_to_local/1 ebif_universaltime_to_localtime_1 bif erlang:unlink/1 -bif 'erl.lang.proc':unlink/1 ebif_unlink_1 bif erlang:unregister/1 -bif 'erl.lang.node':unregister/1 ebif_unregister_1 bif erlang:whereis/1 -bif 'erl.lang.node':whereis/1 ebif_whereis_1 bif erlang:spawn_opt/1 -bif 'erl.lang.proc':spawn_opt/1 ebif_spawn_opt_1 bif erlang:setnode/2 bif erlang:setnode/3 bif erlang:dist_exit/3 @@ -261,190 +158,106 @@ bif erts_internal:port_get_data/1 # Tracing & debugging. bif erlang:trace_pattern/2 -bif 'erl.system.debug':trace_pattern/2 ebif_trace_pattern_2 bif erlang:trace_pattern/3 -bif 'erl.system.debug':trace_pattern/3 ebif_trace_pattern_3 bif erlang:trace/3 -bif 'erl.system.debug':trace/3 ebif_trace_3 bif erlang:trace_info/2 -bif 'erl.system.debug':trace_info/2 ebif_trace_info_2 bif erlang:trace_delivered/1 -bif 'erl.system.debug':trace_delivered/1 ebif_trace_delivered_1 bif erlang:seq_trace/2 -bif 'erl.system.debug':seq_trace/2 ebif_seq_trace_2 bif erlang:seq_trace_info/1 -bif 'erl.system.debug':seq_trace_info/1 ebif_seq_trace_info_1 bif erlang:seq_trace_print/1 -bif 'erl.system.debug':seq_trace_print/1 ebif_seq_trace_print_1 bif erlang:seq_trace_print/2 -bif 'erl.system.debug':seq_trace_print/2 ebif_seq_trace_print_2 bif erlang:suspend_process/2 -bif 'erl.system.debug':suspend_process/2 ebif_suspend_process_2 bif erlang:resume_process/1 -bif 'erl.system.debug':resume_process/1 ebif_resume_process_1 bif erlang:process_display/2 -bif 'erl.system.debug':process_display/2 ebif_process_display_2 bif erlang:bump_reductions/1 -bif 'erl.lang.proc':bump_reductions/1 ebif_bump_reductions_1 bif math:cos/1 -bif 'erl.lang.math':cos/1 ebif_math_cos_1 bif math:cosh/1 -bif 'erl.lang.math':cosh/1 ebif_math_cosh_1 bif math:sin/1 -bif 'erl.lang.math':sin/1 ebif_math_sin_1 bif math:sinh/1 -bif 'erl.lang.math':sinh/1 ebif_math_sinh_1 bif math:tan/1 -bif 'erl.lang.math':tan/1 ebif_math_tan_1 bif math:tanh/1 -bif 'erl.lang.math':tanh/1 ebif_math_tanh_1 bif math:acos/1 -bif 'erl.lang.math':acos/1 ebif_math_acos_1 bif math:acosh/1 -bif 'erl.lang.math':acosh/1 ebif_math_acosh_1 bif math:asin/1 -bif 'erl.lang.math':asin/1 ebif_math_asin_1 bif math:asinh/1 -bif 'erl.lang.math':asinh/1 ebif_math_asinh_1 bif math:atan/1 -bif 'erl.lang.math':atan/1 ebif_math_atan_1 bif math:atanh/1 -bif 'erl.lang.math':atanh/1 ebif_math_atanh_1 bif math:erf/1 -bif 'erl.lang.math':erf/1 ebif_math_erf_1 bif math:erfc/1 -bif 'erl.lang.math':erfc/1 ebif_math_erfc_1 bif math:exp/1 -bif 'erl.lang.math':exp/1 ebif_math_exp_1 bif math:log/1 -bif 'erl.lang.math':log/1 ebif_math_log_1 bif math:log10/1 -bif 'erl.lang.math':log10/1 ebif_math_log10_1 bif math:sqrt/1 -bif 'erl.lang.math':sqrt/1 ebif_math_sqrt_1 bif math:atan2/2 -bif 'erl.lang.math':atan2/2 ebif_math_atan2_2 bif math:pow/2 -bif 'erl.lang.math':pow/2 ebif_math_pow_2 bif erlang:start_timer/3 -bif 'erl.lang.timer':start/3 ebif_start_timer_3 bif erlang:send_after/3 -bif 'erl.lang.timer':send_after/3 ebif_send_after_3 bif erlang:cancel_timer/1 -bif 'erl.lang.timer':cancel/1 ebif_cancel_timer_1 bif erlang:read_timer/1 -bif 'erl.lang.timer':read/1 ebif_read_timer_1 bif erlang:make_tuple/2 -bif 'erl.lang.tuple':make/2 ebif_make_tuple_2 bif erlang:append_element/2 -bif 'erl.lang.tuple':append_element/2 ebif_append_element_2 bif erlang:make_tuple/3 bif erlang:system_flag/2 -bif 'erl.system':set_flag/2 ebif_system_flag_2 bif erlang:system_info/1 -bif 'erl.system':info/1 ebif_system_info_1 # New in R9C bif erlang:system_monitor/0 -bif 'erl.system':monitor/0 ebif_system_monitor_0 bif erlang:system_monitor/1 -bif 'erl.system':monitor/1 ebif_system_monitor_1 bif erlang:system_monitor/2 -bif 'erl.system':monitor/2 ebif_system_monitor_2 # Added 2006-11-07 bif erlang:system_profile/2 -bif 'erl.system':profile/2 ebif_system_profile_2 # End Added 2006-11-07 # Added 2007-01-17 bif erlang:system_profile/0 -bif 'erl.system':profile/0 ebif_system_profile_0 # End Added 2007-01-17 bif erlang:ref_to_list/1 -bif 'erl.lang.ref':to_string/1 ebif_ref_to_string_1 ref_to_list_1 bif erlang:port_to_list/1 -bif 'erl.lang.port':to_string/1 ebif_port_to_string_1 port_to_list_1 bif erlang:fun_to_list/1 -bif 'erl.lang.function':to_string/1 ebif_fun_to_string_1 fun_to_list_1 bif erlang:monitor/2 -bif 'erl.lang.proc':monitor/2 ebif_monitor_2 bif erlang:demonitor/1 -bif 'erl.lang.proc':demonitor/1 ebif_demonitor_1 bif erlang:demonitor/2 -bif 'erl.lang.proc':demonitor/2 ebif_demonitor_2 bif erlang:is_process_alive/1 -bif 'erl.lang.proc':is_alive/1 ebif_proc_is_alive_1 is_process_alive_1 bif erlang:error/1 error_1 -bif 'erl.lang':error/1 ebif_error_1 error_1 bif erlang:error/2 error_2 -bif 'erl.lang':error/2 ebif_error_2 error_2 bif erlang:raise/3 raise_3 -bif 'erl.lang':raise/3 ebif_raise_3 raise_3 bif erlang:get_stacktrace/0 -bif 'erl.lang.proc':get_stacktrace/0 ebif_get_stacktrace_0 bif erlang:is_builtin/3 -bif 'erl.system.code':is_builtin/3 ebif_is_builtin_3 ubif erlang:'and'/2 -ubif 'erl.lang.bool':'and'/2 ebif_and_2 ubif erlang:'or'/2 -ubif 'erl.lang.bool':'or'/2 ebif_or_2 ubif erlang:'xor'/2 -ubif 'erl.lang.bool':'xor'/2 ebif_xor_2 ubif erlang:'not'/1 -ubif 'erl.lang.bool':'not'/1 ebif_not_1 ubif erlang:'>'/2 sgt_2 -ubif 'erl.lang.term':greater/2 ebif_gt_2 sgt_2 ubif erlang:'>='/2 sge_2 -ubif 'erl.lang.term':greater_or_equal/2 ebif_ge_2 sge_2 ubif erlang:'<'/2 slt_2 -ubif 'erl.lang.term':less/2 ebif_lt_2 slt_2 ubif erlang:'=<'/2 sle_2 -ubif 'erl.lang.term':less_or_equal/2 ebif_le_2 sle_2 ubif erlang:'=:='/2 seq_2 -ubif 'erl.lang.term':equal/2 ebif_eq_2 seq_2 ubif erlang:'=='/2 seqeq_2 -ubif 'erl.lang.term':arith_equal/2 ebif_areq_2 seqeq_2 ubif erlang:'=/='/2 sneq_2 -ubif 'erl.lang.term':not_equal/2 ebif_neq_2 sneq_2 ubif erlang:'/='/2 sneqeq_2 -ubif 'erl.lang.term':not_arith_equal/2 ebif_nareq_2 sneqeq_2 ubif erlang:'+'/2 splus_2 -ubif 'erl.lang.number':plus/2 ebif_plus_2 splus_2 ubif erlang:'-'/2 sminus_2 -ubif 'erl.lang.number':minus/2 ebif_minus_2 sminus_2 ubif erlang:'*'/2 stimes_2 -ubif 'erl.lang.number':multiply/2 ebif_multiply_2 stimes_2 ubif erlang:'/'/2 div_2 -ubif 'erl.lang.number':divide/2 ebif_divide_2 div_2 ubif erlang:'div'/2 intdiv_2 -ubif 'erl.lang.integer':'div'/2 ebif_intdiv_2 ubif erlang:'rem'/2 -ubif 'erl.lang.integer':'rem'/2 ebif_rem_2 ubif erlang:'bor'/2 -ubif 'erl.lang.integer':'bor'/2 ebif_bor_2 ubif erlang:'band'/2 -ubif 'erl.lang.integer':'band'/2 ebif_band_2 ubif erlang:'bxor'/2 -ubif 'erl.lang.integer':'bxor'/2 ebif_bxor_2 ubif erlang:'bsl'/2 -ubif 'erl.lang.integer':'bsl'/2 ebif_bsl_2 ubif erlang:'bsr'/2 -ubif 'erl.lang.integer':'bsr'/2 ebif_bsr_2 ubif erlang:'bnot'/1 -ubif 'erl.lang.integer':'bnot'/1 ebif_bnot_1 ubif erlang:'-'/1 sminus_1 -ubif 'erl.lang.number':minus/1 ebif_minus_1 sminus_1 ubif erlang:'+'/1 splus_1 -ubif 'erl.lang.number':plus/1 ebif_plus_1 splus_1 # New operators in R8. These were the only operators missing. # erlang:send/2, erlang:append/2 and erlang:subtract/2 are now also @@ -452,45 +265,27 @@ ubif 'erl.lang.number':plus/1 ebif_plus_1 splus_1 # internal references have been updated to the new ebif_... entries. bif erlang:'!'/2 ebif_bang_2 -bif 'erl.lang.proc':send/2 ebif_send_2 send_2 bif erlang:send/2 -bif 'erl.lang':send/3 ebif_send_3 send_3 bif erlang:send/3 bif erlang:'++'/2 ebif_plusplus_2 -bif 'erl.lang.list':append/2 ebif_append_2 ebif_plusplus_2 bif erlang:append/2 bif erlang:'--'/2 ebif_minusminus_2 -bif 'erl.lang.list':subtract/2 ebif_list_subtract_2 ebif_minusminus_2 bif erlang:subtract/2 ubif erlang:is_atom/1 -ubif 'erl.lang.term':is_atom/1 ebif_is_atom_1 ubif erlang:is_list/1 -ubif 'erl.lang.term':is_list/1 ebif_is_list_1 ubif erlang:is_tuple/1 -ubif 'erl.lang.term':is_tuple/1 ebif_is_tuple_1 ubif erlang:is_float/1 -ubif 'erl.lang.term':is_float/1 ebif_is_float_1 ubif erlang:is_integer/1 -ubif 'erl.lang.term':is_integer/1 ebif_is_integer_1 ubif erlang:is_number/1 -ubif 'erl.lang.term':is_number/1 ebif_is_number_1 ubif erlang:is_pid/1 -ubif 'erl.lang.term':is_pid/1 ebif_is_pid_1 ubif erlang:is_port/1 -ubif 'erl.lang.term':is_port/1 ebif_is_port_1 ubif erlang:is_reference/1 -ubif 'erl.lang.term':is_reference/1 ebif_is_reference_1 ubif erlang:is_binary/1 -ubif 'erl.lang.term':is_binary/1 ebif_is_binary_1 ubif erlang:is_function/1 -ubif 'erl.lang.term':is_function/1 ebif_is_function_1 ubif erlang:is_function/2 -ubif 'erl.lang.term':is_function/2 ebif_is_function_2 ubif erlang:is_record/2 -ubif 'erl.lang.term':is_record/2 ebif_is_record_2 ubif erlang:is_record/3 -ubif 'erl.lang.term':is_record/3 ebif_is_record_3 bif erlang:match_spec_test/3 @@ -499,96 +294,53 @@ bif erlang:match_spec_test/3 # bif ets:all/0 -bif 'erl.lang.ets':all/0 ebif_ets_all_0 bif ets:new/2 -bif 'erl.lang.ets':new/2 ebif_ets_new_2 bif ets:delete/1 -bif 'erl.lang.ets':delete/1 ebif_ets_delete_1 bif ets:delete/2 -bif 'erl.lang.ets':delete/2 ebif_ets_delete_2 bif ets:delete_all_objects/1 -bif 'erl.lang.ets':delete_all_objects/1 ebif_ets_delete_all_objects_1 bif ets:delete_object/2 -bif 'erl.lang.ets':delete_object/2 ebif_ets_delete_object_2 bif ets:first/1 -bif 'erl.lang.ets':first/1 ebif_ets_first_1 bif ets:is_compiled_ms/1 -bif 'erl.lang.ets':is_compiled_ms/1 ebif_ets_is_compiled_ms_1 bif ets:lookup/2 -bif 'erl.lang.ets':lookup/2 ebif_ets_lookup_2 bif ets:lookup_element/3 -bif 'erl.lang.ets':lookup_element/3 ebif_ets_lookup_element_3 bif ets:info/1 -bif 'erl.lang.ets':info/1 ebif_ets_info_1 bif ets:info/2 -bif 'erl.lang.ets':info/2 ebif_ets_info_2 bif ets:last/1 -bif 'erl.lang.ets':last/1 ebif_ets_last_1 bif ets:match/1 -bif 'erl.lang.ets':match/1 ebif_ets_match_1 bif ets:match/2 -bif 'erl.lang.ets':match/2 ebif_ets_match_2 bif ets:match/3 -bif 'erl.lang.ets':match/3 ebif_ets_match_3 bif ets:match_object/1 -bif 'erl.lang.ets':match_object/1 ebif_ets_match_object_1 bif ets:match_object/2 -bif 'erl.lang.ets':match_object/2 ebif_ets_match_object_2 bif ets:match_object/3 -bif 'erl.lang.ets':match_object/3 ebif_ets_match_object_3 bif ets:member/2 -bif 'erl.lang.ets':is_key/2 ebif_ets_member_2 bif ets:next/2 -bif 'erl.lang.ets':next/2 ebif_ets_next_2 bif ets:prev/2 -bif 'erl.lang.ets':prev/2 ebif_ets_prev_2 bif ets:insert/2 -bif 'erl.lang.ets':insert/2 ebif_ets_insert_2 bif ets:insert_new/2 -bif 'erl.lang.ets':insert_new/2 ebif_ets_insert_new_2 bif ets:rename/2 -bif 'erl.lang.ets':rename/2 ebif_ets_rename_2 bif ets:safe_fixtable/2 -bif 'erl.lang.ets':fixtable/2 ebif_ets_safe_fixtable_2 bif ets:slot/2 -bif 'erl.lang.ets':slot/2 ebif_ets_slot_2 bif ets:update_counter/3 -bif 'erl.lang.ets':update_counter/3 ebif_ets_update_counter_3 bif ets:select/1 -bif 'erl.lang.ets':select/1 ebif_ets_select_1 bif ets:select/2 -bif 'erl.lang.ets':select/2 ebif_ets_select_2 bif ets:select/3 -bif 'erl.lang.ets':select/3 ebif_ets_select_3 bif ets:select_count/2 -bif 'erl.lang.ets':select/2 ebif_ets_select_count_2 bif ets:select_reverse/1 -bif 'erl.lang.ets':select_reverse/1 ebif_ets_select_reverse_1 bif ets:select_reverse/2 -bif 'erl.lang.ets':select_reverse/2 ebif_ets_select_reverse_2 bif ets:select_reverse/3 -bif 'erl.lang.ets':select_reverse/3 ebif_ets_select_reverse_3 bif ets:select_delete/2 -bif 'erl.lang.ets':select_delete/2 ebif_ets_select_delete_2 bif ets:match_spec_compile/1 -bif 'erl.lang.ets':match_spec_compile/1 ebif_ets_match_spec_compile_1 bif ets:match_spec_run_r/3 -bif 'erl.lang.ets':match_spec_run_r/3 ebif_ets_match_spec_run_r_3 # # Bifs in os module. # bif os:putenv/2 -bif 'erl.system.os':setenv/2 ebif_os_setenv_2 os_putenv_2 bif os:getenv/0 -bif 'erl.system.os':getenv/0 ebif_os_getenv_0 bif os:getenv/1 -bif 'erl.system.os':getenv/1 ebif_os_getenv_1 bif os:getpid/0 -bif 'erl.system.os':pid/0 ebif_os_pid_0 os_getpid_0 bif os:timestamp/0 -bif 'erl.system.os':timestamp/0 ebif_os_timestamp_0 os_timestamp_0 # # Bifs in the erl_ddll module (the module actually does not exist) @@ -615,13 +367,9 @@ bif re:run/3 # bif lists:member/2 -bif 'erl.lang.list':is_element/2 ebif_list_is_element_2 lists_member_2 bif lists:reverse/2 -bif 'erl.lang.list':reverse/2 ebif_list_reverse_2 lists_reverse_2 bif lists:keymember/3 -bif 'erl.lang.list.keylist':is_element/3 ebif_keylist_is_element_3 lists_keymember_3 bif lists:keysearch/3 -bif 'erl.lang.list.keylist':search/3 ebif_keylist_search_3 lists_keysearch_3 bif lists:keyfind/3 # @@ -629,21 +377,13 @@ bif lists:keyfind/3 # bif erts_debug:disassemble/1 -bif 'erl.system.debug':disassemble/1 ebif_erts_debug_disassemble_1 bif erts_debug:breakpoint/2 -bif 'erl.system.debug':breakpoint/2 ebif_erts_debug_breakpoint_2 bif erts_debug:same/2 -bif 'erl.system.debug':same/2 ebif_erts_debug_same_2 bif erts_debug:flat_size/1 -bif 'erl.system.debug':flat_size/1 ebif_erts_debug_flat_size_1 bif erts_debug:get_internal_state/1 -bif 'erl.system.debug':get_internal_state/1 ebif_erts_debug_get_internal_state_1 bif erts_debug:set_internal_state/2 -bif 'erl.system.debug':set_internal_state/2 ebif_erts_debug_set_internal_state_2 bif erts_debug:display/1 -bif 'erl.system.debug':display/1 ebif_erts_debug_display_1 bif erts_debug:dist_ext_to_term/2 -bif 'erl.system.debug':dist_ext_to_term/2 ebif_erts_debug_dist_ext_to_term_2 bif erts_debug:instructions/0 # @@ -663,13 +403,9 @@ bif erts_debug:lock_counters/1 # bif code:get_chunk/2 -bif 'erl.system.code':get_chunk/2 ebif_code_get_chunk_2 bif code:module_md5/1 -bif 'erl.system.code':module_md5/1 ebif_code_module_md5_1 bif code:make_stub_module/3 -bif 'erl.system.code':make_stub_module/3 ebif_code_make_stub_module_3 bif code:is_module_native/1 -bif 'erl.system.code':is_native/1 ebif_code_is_native_1 code_is_module_native_1 # # New Bifs in R9C. @@ -821,6 +557,8 @@ bif erlang:dt_append_vm_tag_data/1 # bif erlang:prepare_loading/2 bif erlang:finish_loading/1 +bif erlang:insert_element/3 +bif erlang:delete_element/2 # # Obsolete diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index f169a1a34a..64cd93a100 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -67,7 +67,7 @@ dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz) { byte *extp = edep->extp; Eterm msg; - Sint size = erts_decode_dist_ext_size(edep, 0); + Sint size = erts_decode_dist_ext_size(edep); if (size < 0) { erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(%s) failed:\n", diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c index 570cc59be2..306b32691c 100644 --- a/erts/emulator/beam/erl_afit_alloc.c +++ b/erts/emulator/beam/erl_afit_alloc.c @@ -37,6 +37,12 @@ #define GET_ERL_AF_ALLOC_IMPL #include "erl_afit_alloc.h" +struct AFFreeBlock_t_ { + Block_t block_head; + AFFreeBlock_t *prev; + AFFreeBlock_t *next; +}; +#define AF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->block_head) #define MIN_MBC_SZ (16*1024) #define MIN_MBC_FIRST_FREE_SZ (4*1024) @@ -80,7 +86,6 @@ erts_afalc_start(AFAllctr_t *afallctr, init->sbmbct = 0; /* Small mbc not supported by afit */ - allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = sizeof(AFFreeBlock_t); @@ -118,7 +123,7 @@ get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size, ASSERT(!cand_blk || cand_size >= size); - if (afallctr->free_list && BLK_SZ(afallctr->free_list) >= size) { + if (afallctr->free_list && AF_BLK_SZ(afallctr->free_list) >= size) { AFFreeBlock_t *res = afallctr->free_list; afallctr->free_list = res->next; if (res->next) @@ -135,7 +140,7 @@ link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) AFFreeBlock_t *blk = (AFFreeBlock_t *) block; AFAllctr_t *afallctr = (AFAllctr_t *) allctr; - if (afallctr->free_list && BLK_SZ(afallctr->free_list) > BLK_SZ(blk)) { + if (afallctr->free_list && AF_BLK_SZ(afallctr->free_list) > AF_BLK_SZ(blk)) { blk->next = afallctr->free_list->next; blk->prev = afallctr->free_list; afallctr->free_list->next = blk; diff --git a/erts/emulator/beam/erl_afit_alloc.h b/erts/emulator/beam/erl_afit_alloc.h index ea408a7194..87caccac20 100644 --- a/erts/emulator/beam/erl_afit_alloc.h +++ b/erts/emulator/beam/erl_afit_alloc.h @@ -49,11 +49,6 @@ Allctr_t *erts_afalc_start(AFAllctr_t *, AFAllctrInit_t *, AllctrInit_t *); #include "erl_alloc_util.h" typedef struct AFFreeBlock_t_ AFFreeBlock_t; -struct AFFreeBlock_t_ { - Block_t block_head; - AFFreeBlock_t *prev; - AFFreeBlock_t *next; -}; struct AFAllctr_t_ { Allctr_t allctr; /* Has to be first! */ diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 04d807b780..5da8c69c03 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -310,9 +310,9 @@ set_default_ll_alloc_opts(struct au_init *ip) ip->init.util.name_prefix = "ll_"; ip->init.util.alloc_no = ERTS_ALC_A_LONG_LIVED; #ifndef SMALL_MEMORY - ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ + ip->init.util.mmbcs = 2*1024*1024 - 40; /* Main carrier size */ #else - ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ + ip->init.util.mmbcs = 1*1024*1024 - 40; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_LONG_LIVED; ip->init.util.asbcst = 0; @@ -1173,6 +1173,11 @@ handle_au_arg(struct au_init *auip, break; case 'e': auip->enable = get_bool_value(sub_param+1, argv, ip); +#if !HAVE_ERTS_SBMBC + if (auip->init.util.alloc_no == ERTS_ALC_A_SBMBC) { + auip->enable = 0; + } +#endif break; case 'l': if (has_prefix("lmbcs", sub_param)) { @@ -1233,10 +1238,16 @@ handle_au_arg(struct au_init *auip, auip->init.util.sbct = get_kb_value(sub_param + 4, argv, ip); } else if (has_prefix("sbmbcs", sub_param)) { - auip->init.util.sbmbcs = get_byte_value(sub_param + 6, argv, ip); +#if HAVE_ERTS_SBMBC + auip->init.util.sbmbcs = +#endif + get_byte_value(sub_param + 6, argv, ip); } else if (has_prefix("sbmbct", sub_param)) { - auip->init.util.sbmbct = get_byte_value(sub_param + 6, argv, ip); +#if HAVE_ERTS_SBMBC + auip->init.util.sbmbct = +#endif + get_byte_value(sub_param + 6, argv, ip); } else if (has_prefix("smbcs", sub_param)) { auip->default_.smbcs = 0; @@ -1403,6 +1414,9 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) else if (strcmp("max", arg) == 0) { for (a = 0; a < aui_sz; a++) aui[a]->enable = 1; +#if !HAVE_ERTS_SBMBC + init->sbmbc_alloc.enable = 0; +#endif } else if (strcmp("config", arg) == 0) { init->erts_alloc_config = 1; diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 97ba306a79..3d6761339b 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -78,10 +78,12 @@ int erts_have_sbmbc_alloc; #if HAVE_ERTS_MSEG -#define INV_MSEG_UNIT_MASK ((UWord) (mseg_unit_size - 1)) -#define MSEG_UNIT_MASK (~INV_MSEG_UNIT_MASK) +#define MSEG_UNIT_SHIFT MSEG_ALIGN_BITS +#define MSEG_UNIT_SZ (1 << MSEG_UNIT_SHIFT) +#define MSEG_UNIT_MASK ((~(UWord)0) << MSEG_UNIT_SHIFT) + #define MSEG_UNIT_FLOOR(X) ((X) & MSEG_UNIT_MASK) -#define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + INV_MSEG_UNIT_MASK) +#define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + ~MSEG_UNIT_MASK) #endif @@ -104,7 +106,6 @@ int erts_have_sbmbc_alloc; static Uint sys_alloc_carrier_size; #if HAVE_ERTS_MSEG static Uint max_mseg_carriers; -static Uint mseg_unit_size; #endif #define ONE_GIGA (1000000000) @@ -117,16 +118,47 @@ static Uint mseg_unit_size; ? ((CC).giga_no--, (CC).no = ONE_GIGA - 1) \ : (CC).no--) -/* ... */ +/* Multi block carrier (MBC) memory layout in R16: + +Empty MBC: +[Carrier_t|pad|Block_t L0T|fhdr| free... ] + +MBC after allocating first block: +[Carrier_t|pad|Block_t 000| udata |pad|Block_t L0T|fhdr| free... ] + +MBC after allocating second block: +[Carrier_t|pad|Block_t 000| udata |pad|Block_t 000| udata |pad|Block_t L0T|fhdr| free... ] + +MBC after deallocating first block: +[Carrier_t|pad|Block_t 00T|fhdr| free |FreeBlkFtr_t|Block_t 0P0| udata |pad|Block_t L0T|fhdr| free... ] + + + udata = Allocated user data + pad = Padding to ensure correct alignment for user data + fhdr = Allocator specific header to keep track of free block + free = Unused free memory + T = This block is free (THIS_FREE_BLK_HDR_FLG) + P = Previous block is free (PREV_FREE_BLK_HDR_FLG) + L = Last block in carrier (LAST_BLK_HDR_FLG) +*/ + +/* Single block carrier (SBC): +[Carrier_t|pad|Block_t 111| udata... ] +*/ + /* Blocks ... */ -#define SBC_BLK_FTR_FLG (((UWord) 1) << 0) +#define UNUSED0_BLK_FTR_FLG (((UWord) 1) << 0) #define UNUSED1_BLK_FTR_FLG (((UWord) 1) << 1) #define UNUSED2_BLK_FTR_FLG (((UWord) 1) << 2) -#define ABLK_HDR_SZ (sizeof(Block_t)) -#define FBLK_FTR_SZ (sizeof(UWord)) +#if MBC_ABLK_OFFSET_BITS +# define ABLK_HDR_SZ (offsetof(Block_t,u)) +#else +# define ABLK_HDR_SZ (sizeof(Block_t)) +#endif +#define FBLK_FTR_SZ (sizeof(FreeBlkFtr_t)) #define UMEMSZ2BLKSZ(AP, SZ) \ (ABLK_HDR_SZ + (SZ) <= (AP)->min_block_size \ @@ -136,88 +168,181 @@ static Uint mseg_unit_size; #define UMEM2BLK(P) ((Block_t *) (((char *) (P)) - ABLK_HDR_SZ)) #define BLK2UMEM(P) ((void *) (((char *) (P)) + ABLK_HDR_SZ)) -#define PREV_BLK_SZ(B) \ - ((UWord) (*(((UWord *) (B)) - 1) & SZ_MASK)) +#define PREV_BLK_SZ(B) ((UWord) (((FreeBlkFtr_t *)(B))[-1])) #define SET_BLK_SZ_FTR(B, SZ) \ - (*((UWord *) (((char *) (B)) + (SZ) - sizeof(UWord))) = (SZ)) + (((FreeBlkFtr_t *) (((char *) (B)) + (SZ)))[-1] = (SZ)) #define THIS_FREE_BLK_HDR_FLG (((UWord) 1) << 0) #define PREV_FREE_BLK_HDR_FLG (((UWord) 1) << 1) #define LAST_BLK_HDR_FLG (((UWord) 1) << 2) -#define SET_BLK_SZ(B, SZ) \ +/* Special flag combo for (allocated) SBC blocks +*/ +#define SBC_BLK_HDR_FLG (THIS_FREE_BLK_HDR_FLG | PREV_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG) + +#define SET_MBC_ABLK_SZ(B, SZ) \ (ASSERT(((SZ) & FLG_MASK) == 0), \ - (*((Block_t *) (B)) = ((*((Block_t *) (B)) & FLG_MASK) | (SZ)))) -#define SET_BLK_FREE(B) \ - (*((Block_t *) (B)) |= THIS_FREE_BLK_HDR_FLG) -#define SET_BLK_ALLOCED(B) \ - (*((Block_t *) (B)) &= ~THIS_FREE_BLK_HDR_FLG) -#define SET_PREV_BLK_FREE(B) \ - (*((Block_t *) (B)) |= PREV_FREE_BLK_HDR_FLG) + (B)->bhdr = (((B)->bhdr) & ~MBC_ABLK_SZ_MASK) | (SZ)) +#define SET_MBC_FBLK_SZ(B, SZ) \ + (ASSERT(((SZ) & FLG_MASK) == 0), \ + (B)->bhdr = (((B)->bhdr) & ~MBC_FBLK_SZ_MASK) | (SZ)) +#define SET_SBC_BLK_SZ(B, SZ) \ + (ASSERT(((SZ) & FLG_MASK) == 0), \ + (B)->bhdr = (((B)->bhdr) & ~SBC_BLK_SZ_MASK) | (SZ)) +#define SET_PREV_BLK_FREE(AP,B) \ + (ASSERT(!IS_MBC_FIRST_BLK(AP,B)), \ + ASSERT(!IS_FREE_BLK(B)), \ + (B)->bhdr |= PREV_FREE_BLK_HDR_FLG) #define SET_PREV_BLK_ALLOCED(B) \ - (*((Block_t *) (B)) &= ~PREV_FREE_BLK_HDR_FLG) + ((B)->bhdr &= ~PREV_FREE_BLK_HDR_FLG) #define SET_LAST_BLK(B) \ - (*((Block_t *) (B)) |= LAST_BLK_HDR_FLG) + ((B)->bhdr |= LAST_BLK_HDR_FLG) #define SET_NOT_LAST_BLK(B) \ - (*((Block_t *) (B)) &= ~LAST_BLK_HDR_FLG) + ((B)->bhdr &= ~LAST_BLK_HDR_FLG) #define SBH_THIS_FREE THIS_FREE_BLK_HDR_FLG -#define SBH_THIS_ALLOCED ((UWord) 0) #define SBH_PREV_FREE PREV_FREE_BLK_HDR_FLG -#define SBH_PREV_ALLOCED ((UWord) 0) #define SBH_LAST_BLK LAST_BLK_HDR_FLG -#define SBH_NOT_LAST_BLK ((UWord) 0) -#define SET_BLK_HDR(B, Sz, F) \ - (ASSERT(((Sz) & FLG_MASK) == 0), *((Block_t *) (B)) = ((Sz) | (F))) + +#if MBC_ABLK_OFFSET_BITS + +# define MBC_SZ_MAX_LIMIT ((((UWord)1 << MBC_ABLK_OFFSET_BITS) - 1) << MSEG_ALIGN_BITS) + +# define BLK_CARRIER_OFFSET(B, C) (((char*)(B) - (char*)(C)) >> MSEG_UNIT_SHIFT) + +# define SET_MBC_ABLK_HDR(B, Sz, F, C) \ + (ASSERT(((Sz) & ~MBC_ABLK_SZ_MASK) == 0), \ + ASSERT(!((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG))), \ + (B)->bhdr = ((Sz) | (F) | (BLK_CARRIER_OFFSET(B,C) << MBC_ABLK_OFFSET_SHIFT))) + +# define SET_MBC_FBLK_HDR(B, Sz, F, C) \ + (ASSERT(((Sz) & ~MBC_FBLK_SZ_MASK) == 0), \ + ASSERT(((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG|PREV_FREE_BLK_HDR_FLG)) == THIS_FREE_BLK_HDR_FLG), \ + (B)->bhdr = ((Sz) | (F)), \ + (B)->u.carrier = (C)) + +# define ABLK_TO_MBC(B) \ + (ASSERT(IS_MBC_BLK(B) && IS_ALLOCED_BLK(B)), \ + (Carrier_t*)((MSEG_UNIT_FLOOR((UWord)(B)) - \ + (((B)->bhdr >> MBC_ABLK_OFFSET_SHIFT) << MSEG_UNIT_SHIFT)))) + +# define FBLK_TO_MBC(B) \ + (ASSERT(IS_MBC_BLK(B) && IS_FREE_BLK(B)), \ + (B)->u.carrier) + +# define BLK_TO_MBC(B) (IS_FREE_BLK(B) ? FBLK_TO_MBC(B) : ABLK_TO_MBC(B)) + +# define IS_MBC_FIRST_ABLK(AP,B) \ + ((((UWord)(B) & ~MSEG_UNIT_MASK) == MBC_HEADER_SIZE(AP)) \ + && ((B)->bhdr & MBC_ABLK_OFFSET_MASK) == 0) + +# define IS_MBC_FIRST_FBLK(AP,B) \ + ((char*)(B) == (char*)((B)->u.carrier) + MBC_HEADER_SIZE(AP)) + +# define IS_MBC_FIRST_BLK(AP,B) \ + (IS_FREE_BLK(B) ? IS_MBC_FIRST_FBLK(AP,B) : IS_MBC_FIRST_ABLK(AP,B)) + +# define SET_BLK_FREE(B) \ + (ASSERT(!IS_PREV_BLK_FREE(B)), \ + (B)->u.carrier = ABLK_TO_MBC(B), \ + (B)->bhdr |= THIS_FREE_BLK_HDR_FLG, \ + (B)->bhdr &= (MBC_ABLK_SZ_MASK|FLG_MASK)) + +# define SET_BLK_ALLOCED(B) \ + (ASSERT(((B)->bhdr & (MBC_ABLK_OFFSET_MASK|THIS_FREE_BLK_HDR_FLG)) == THIS_FREE_BLK_HDR_FLG), \ + (B)->bhdr &= ~THIS_FREE_BLK_HDR_FLG, \ + (B)->bhdr |= (BLK_CARRIER_OFFSET(B,(B)->u.carrier) << MBC_ABLK_OFFSET_SHIFT)) + +#else /* !MBC_ABLK_OFFSET_BITS */ + +# define MBC_SZ_MAX_LIMIT ((UWord)~0) + +# define SET_MBC_ABLK_HDR(B, Sz, F, C) \ + (ASSERT(((Sz) & FLG_MASK) == 0), \ + ASSERT(!((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG))), \ + ASSERT((UWord)(F) < SBC_BLK_HDR_FLG), \ + (B)->bhdr = ((Sz) | (F)), \ + (B)->carrier = (C)) + +# define SET_MBC_FBLK_HDR(B, Sz, F, C) \ + (ASSERT(((Sz) & FLG_MASK) == 0), \ + ASSERT(((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG|PREV_FREE_BLK_HDR_FLG)) == THIS_FREE_BLK_HDR_FLG), \ + (B)->bhdr = ((Sz) | (F)), \ + (B)->carrier = (C)) + +# define BLK_TO_MBC(B) ((B)->carrier) +# define ABLK_TO_MBC(B) BLK_TO_MBC(B) +# define FBLK_TO_MBC(B) BLK_TO_MBC(B) + +# define IS_MBC_FIRST_BLK(AP,B) \ + ((char*)(B) == (char*)((B)->carrier) + MBC_HEADER_SIZE(AP)) +# define IS_MBC_FIRST_ABLK(AP,B) IS_MBC_FIRST_BLK(AP,B) +# define IS_MBC_FIRST_FBLK(AP,B) IS_MBC_FIRST_BLK(AP,B) + +# define SET_BLK_FREE(B) \ + (ASSERT(!IS_PREV_BLK_FREE(B)), \ + (B)->bhdr |= THIS_FREE_BLK_HDR_FLG) + +# define SET_BLK_ALLOCED(B) \ + ((B)->bhdr &= ~THIS_FREE_BLK_HDR_FLG) + +#endif /* !MBC_ABLK_OFFSET_BITS */ + +#define SET_SBC_BLK_HDR(B, Sz) \ + (ASSERT(((Sz) & FLG_MASK) == 0), (B)->bhdr = ((Sz) | (SBC_BLK_HDR_FLG))) + #define BLK_UMEM_SZ(B) \ (BLK_SZ(B) - (ABLK_HDR_SZ)) #define IS_PREV_BLK_FREE(B) \ - (*((Block_t *) (B)) & PREV_FREE_BLK_HDR_FLG) + ((B)->bhdr & PREV_FREE_BLK_HDR_FLG) #define IS_PREV_BLK_ALLOCED(B) \ (!IS_PREV_BLK_FREE((B))) #define IS_FREE_BLK(B) \ - (*((Block_t *) (B)) & THIS_FREE_BLK_HDR_FLG) + (ASSERT(!IS_SBC_BLK(B)), (B)->bhdr & THIS_FREE_BLK_HDR_FLG) #define IS_ALLOCED_BLK(B) \ (!IS_FREE_BLK((B))) #define IS_LAST_BLK(B) \ - (*((Block_t *) (B)) & LAST_BLK_HDR_FLG) + ((B)->bhdr & LAST_BLK_HDR_FLG) #define IS_NOT_LAST_BLK(B) \ (!IS_LAST_BLK((B))) #define GET_LAST_BLK_HDR_FLG(B) \ - (*((Block_t*) (B)) & LAST_BLK_HDR_FLG) + ((B)->bhdr & LAST_BLK_HDR_FLG) #define GET_THIS_FREE_BLK_HDR_FLG(B) \ - (*((Block_t*) (B)) & THIS_FREE_BLK_HDR_FLG) + ((B)->bhdr & THIS_FREE_BLK_HDR_FLG) #define GET_PREV_FREE_BLK_HDR_FLG(B) \ - (*((Block_t*) (B)) & PREV_FREE_BLK_HDR_FLG) + ((B)->bhdr & PREV_FREE_BLK_HDR_FLG) #define GET_BLK_HDR_FLGS(B) \ - (*((Block_t*) (B)) & FLG_MASK) - -#define IS_FIRST_BLK(B) \ - (IS_PREV_BLK_FREE((B)) && (PREV_BLK_SZ((B)) == 0)) -#define IS_NOT_FIRST_BLK(B) \ - (!IS_FIRST_BLK((B))) - -#define SET_SBC_BLK_FTR(FTR) \ - ((FTR) = (0 | SBC_BLK_FTR_FLG)) -#define SET_MBC_BLK_FTR(FTR) \ - ((FTR) = 0) + ((B)->bhdr & FLG_MASK) #define IS_SBC_BLK(B) \ - (IS_PREV_BLK_FREE((B)) && (((UWord *) (B))[-1] & SBC_BLK_FTR_FLG)) + (((B)->bhdr & FLG_MASK) == SBC_BLK_HDR_FLG) #define IS_MBC_BLK(B) \ (!IS_SBC_BLK((B))) +#define MBC_BLK_SZ(B) (IS_FREE_BLK(B) ? MBC_FBLK_SZ(B) : MBC_ABLK_SZ(B)) + #define NXT_BLK(B) \ - ((Block_t *) (((char *) (B)) + BLK_SZ((B)))) + (ASSERT(IS_MBC_BLK(B)), \ + (Block_t *) (((char *) (B)) + MBC_BLK_SZ((B)))) #define PREV_BLK(B) \ ((Block_t *) (((char *) (B)) - PREV_BLK_SZ((B)))) +#define BLK_AFTER(B,Sz) \ + ((Block_t *) (((char *) (B)) + (Sz))) + +#define BLK_SZ(B) ((B)->bhdr & (((B)->bhdr & THIS_FREE_BLK_HDR_FLG) ? MBC_FBLK_SZ_MASK : MBC_ABLK_SZ_MASK)) + /* Carriers ... */ +#define SBC_HEADER_SIZE (UNIT_CEILING(sizeof(Carrier_t) + ABLK_HDR_SZ) \ + - ABLK_HDR_SZ) +#define MBC_HEADER_SIZE(AP) SBC_HEADER_SIZE + + #define MSEG_CARRIER_HDR_FLAG (((UWord) 1) << 0) #define SBC_CARRIER_HDR_FLAG (((UWord) 1) << 1) @@ -226,20 +351,20 @@ static Uint mseg_unit_size; #define SCH_MBC 0 #define SCH_SBC SBC_CARRIER_HDR_FLAG -#define SET_CARRIER_HDR(C, Sz, F) \ - (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F))) +#define SET_CARRIER_HDR(C, Sz, F, AP) \ + (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F)), (C)->allctr = (AP)) -#define BLK2SBC(AP, B) \ - ((Carrier_t *) (((char *) (B)) - (AP)->sbc_header_size)) -#define FBLK2MBC(AP, B) \ - ((Carrier_t *) (((char *) (B)) - (AP)->mbc_header_size)) +#define BLK_TO_SBC(B) \ + ((Carrier_t *) (((char *) (B)) - SBC_HEADER_SIZE)) +#define FIRST_BLK_TO_MBC(AP, B) \ + ((Carrier_t *) (((char *) (B)) - MBC_HEADER_SIZE(AP))) -#define MBC2FBLK(AP, P) \ - ((Block_t *) (((char *) (P)) + (AP)->mbc_header_size)) +#define MBC_TO_FIRST_BLK(AP, P) \ + ((Block_t *) (((char *) (P)) + MBC_HEADER_SIZE(AP))) #define SBC2BLK(AP, P) \ - ((Block_t *) (((char *) (P)) + (AP)->sbc_header_size)) + ((Block_t *) (((char *) (P)) + SBC_HEADER_SIZE)) #define SBC2UMEM(AP, P) \ - ((void *) (((char *) (P)) + ((AP)->sbc_header_size + ABLK_HDR_SZ))) + ((void *) (((char *) (P)) + (SBC_HEADER_SIZE + ABLK_HDR_SZ))) #define IS_MSEG_CARRIER(C) \ ((C)->chdr & MSEG_CARRIER_HDR_FLAG) @@ -250,15 +375,6 @@ static Uint mseg_unit_size; #define IS_MB_CARRIER(C) \ (!IS_SB_CARRIER((C))) -#define SET_MSEG_CARRIER(C) \ - ((C)->chdr |= MSEG_CARRIER_HDR_FLAG) -#define SET_SYS_ALLOC_CARRIER(C) \ - ((C)->chdr &= ~MSEG_CARRIER_HDR_FLAG) -#define SET_SB_CARRIER(C) \ - ((C)->chdr |= SBC_CARRIER_HDR_FLAG) -#define SET_MB_CARRIER(C) \ - ((C)->chdr &= ~SBC_CARRIER_HDR_FLAG) - #define SET_CARRIER_SZ(C, SZ) \ (ASSERT(((SZ) & FLG_MASK) == 0), \ ((C)->chdr = ((C)->chdr & FLG_MASK) | (SZ))) @@ -506,11 +622,11 @@ static void mbc_free(Allctr_t *allctr, void *p); #if HAVE_ERTS_MSEG static ERTS_INLINE void * -alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p) +alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) { void *res; - res = erts_mseg_alloc_opt(allctr->alloc_no, size_p, &allctr->mseg_opt); + res = erts_mseg_alloc_opt(allctr->alloc_no, size_p, flags, &allctr->mseg_opt); INC_CC(allctr->calls.mseg_alloc); return res; } @@ -521,7 +637,7 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) void *res; res = erts_mseg_realloc_opt(allctr->alloc_no, seg, old_size, new_size_p, - &allctr->mseg_opt); + ERTS_MSEG_FLG_NONE, &allctr->mseg_opt); INC_CC(allctr->calls.mseg_realloc); return res; } @@ -765,13 +881,9 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) #define ERTS_ALCU_DD_FIX_TYPE_OFFS \ ((sizeof(ErtsAllctrDDBlock_t)-1)/sizeof(UWord) + 1) -#define ERTS_AU_PREF_ALLOC_IX_MASK \ - ((((UWord) 1) << ERTS_AU_PREF_ALLOC_BITS) - 1) -#define ERTS_AU_PREF_ALLOC_SIZE_MASK \ - ((((UWord) 1) << (sizeof(UWord)*8 - ERTS_AU_PREF_ALLOC_BITS)) - 1) -static ERTS_INLINE int -get_pref_allctr(void *extra, Allctr_t **allctr) +static ERTS_INLINE Allctr_t* +get_pref_allctr(void *extra) { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; int pref_ix; @@ -781,34 +893,33 @@ get_pref_allctr(void *extra, Allctr_t **allctr) ASSERT(sizeof(UWord) == sizeof(Allctr_t *)); ASSERT(0 <= pref_ix && pref_ix < tspec->size); - *allctr = tspec->allctr[pref_ix]; - return pref_ix; + return tspec->allctr[pref_ix]; } -static ERTS_INLINE void * -get_used_allctr(void *extra, void *p, Allctr_t **allctr, UWord *sizep) +/* SMP note: + * get_used_allctr() must be safe WITHOUT locking the allocator while + * concurrent threads may be updating adjacent blocks. + * We rely on getting a consistent result (without atomic op) when reading + * the block header word even if a concurrent thread is updating + * the "PREV_FREE" flag bit. + */ +static ERTS_INLINE Allctr_t* +get_used_allctr(void *extra, void *p, UWord *sizep) { - ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; - void *ptr = (void *) (((char *) p) - sizeof(UWord)); - UWord ainfo = *((UWord *) ptr); - int aix = (int) (ainfo & ERTS_AU_PREF_ALLOC_IX_MASK); - *allctr = tspec->allctr[aix]; - if (sizep) - *sizep = ((ainfo >> ERTS_AU_PREF_ALLOC_BITS) - & ERTS_AU_PREF_ALLOC_SIZE_MASK); - return ptr; -} + Block_t* blk = UMEM2BLK(p); + Carrier_t* crr; -static ERTS_INLINE void * -put_used_allctr(void *p, int ix, UWord size) -{ - UWord ainfo = (size >= ERTS_AU_PREF_ALLOC_SIZE_MASK - ? ERTS_AU_PREF_ALLOC_SIZE_MASK - : size); - ainfo <<= ERTS_AU_PREF_ALLOC_BITS; - ainfo |= (UWord) ix; - *((UWord *) p) = ainfo; - return (void *) (((char *) p) + sizeof(UWord)); + if (IS_SBC_BLK(blk)) { + crr = BLK_TO_SBC(blk); + if (sizep) + *sizep = SBC_BLK_SZ(blk) - ABLK_HDR_SZ; + } + else { + crr = ABLK_TO_MBC(blk); + if (sizep) + *sizep = MBC_ABLK_SZ(blk) - ABLK_HDR_SZ; + } + return crr->allctr; } static void @@ -1209,10 +1320,8 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp, Uint32 *alcu_flgsp) if ((*alcu_flgsp) & ERTS_ALCU_FLG_SBMBC) blk = create_sbmbc(allctr, get_blk_sz); else { -#if HALFWORD_HEAP - blk = create_carrier(allctr, get_blk_sz, CFLG_MBC|CFLG_FORCE_MSEG); -#else blk = create_carrier(allctr, get_blk_sz, CFLG_MBC); +#if !HALFWORD_HEAP && !HAVE_SUPER_ALIGNED_MB_CARRIERS if (!blk) { /* Emergency! We couldn't create the carrier as we wanted. Try to place it in a sys_alloced sbc. */ @@ -1242,6 +1351,7 @@ mbc_alloc_finalize(Allctr_t *allctr, Block_t *blk, Uint org_blk_sz, UWord flags, + Carrier_t *crr, Uint want_blk_sz, int valid_blk_info, Uint32 alcu_flgs) @@ -1262,22 +1372,18 @@ mbc_alloc_finalize(Allctr_t *allctr, /* Shrink block... */ blk_sz = want_blk_sz; nxt_blk_sz = org_blk_sz - blk_sz; - SET_BLK_HDR(blk, - blk_sz, - SBH_THIS_ALLOCED|SBH_NOT_LAST_BLK|prev_free_flg); + SET_MBC_ABLK_HDR(blk, blk_sz, prev_free_flg, crr); - nxt_blk = NXT_BLK(blk); - SET_BLK_HDR(nxt_blk, - nxt_blk_sz, - (SBH_THIS_FREE - | SBH_PREV_ALLOCED - | (flags & LAST_BLK_HDR_FLG))); + nxt_blk = BLK_AFTER(blk, blk_sz); + SET_MBC_FBLK_HDR(nxt_blk, nxt_blk_sz, + SBH_THIS_FREE|(flags & LAST_BLK_HDR_FLG), + crr); if (!(flags & LAST_BLK_HDR_FLG)) { SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); if (!valid_blk_info) { - Block_t *nxt_nxt_blk = NXT_BLK(nxt_blk); - SET_PREV_BLK_FREE(nxt_nxt_blk); + Block_t *nxt_nxt_blk = BLK_AFTER(nxt_blk, nxt_blk_sz); + SET_PREV_BLK_FREE(allctr, nxt_nxt_blk); } } (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); @@ -1291,40 +1397,40 @@ mbc_alloc_finalize(Allctr_t *allctr, || nxt_blk == PREV_BLK(NXT_BLK(nxt_blk))); ASSERT((flags & LAST_BLK_HDR_FLG) || IS_PREV_BLK_FREE(NXT_BLK(nxt_blk))); - ASSERT(nxt_blk_sz == BLK_SZ(nxt_blk)); + ASSERT(nxt_blk_sz == MBC_BLK_SZ(nxt_blk)); ASSERT(nxt_blk_sz % sizeof(Unit_t) == 0); ASSERT(nxt_blk_sz >= allctr->min_block_size); + ASSERT(ABLK_TO_MBC(blk) == crr); + ASSERT(FBLK_TO_MBC(nxt_blk) == crr); } else { + ASSERT(org_blk_sz <= MBC_ABLK_SZ_MASK); blk_sz = org_blk_sz; if (flags & LAST_BLK_HDR_FLG) { if (valid_blk_info) SET_BLK_ALLOCED(blk); else - SET_BLK_HDR(blk, - blk_sz, - SBH_THIS_ALLOCED|SBH_LAST_BLK|prev_free_flg); + SET_MBC_ABLK_HDR(blk, blk_sz, SBH_LAST_BLK|prev_free_flg, crr); } else { if (valid_blk_info) SET_BLK_ALLOCED(blk); else - SET_BLK_HDR(blk, - blk_sz, - SBH_THIS_ALLOCED|SBH_NOT_LAST_BLK|prev_free_flg); - nxt_blk = NXT_BLK(blk); + SET_MBC_ABLK_HDR(blk, blk_sz, prev_free_flg, crr); + nxt_blk = BLK_AFTER(blk, blk_sz); SET_PREV_BLK_ALLOCED(nxt_blk); } ASSERT((flags & LAST_BLK_HDR_FLG) ? IS_LAST_BLK(blk) : IS_NOT_LAST_BLK(blk)); + ASSERT(ABLK_TO_MBC(blk) == crr); } STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); - ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz == MBC_BLK_SZ(blk)); ASSERT(blk_sz % sizeof(Unit_t) == 0); ASSERT(blk_sz >= allctr->min_block_size); ASSERT(blk_sz >= want_blk_sz); @@ -1348,8 +1454,9 @@ mbc_alloc(Allctr_t *allctr, Uint size) if (IS_MBC_BLK(blk)) mbc_alloc_finalize(allctr, blk, - BLK_SZ(blk), + MBC_FBLK_SZ(blk), GET_BLK_HDR_FLGS(blk), + FBLK_TO_MBC(blk), blk_sz, 1, alcu_flgs); @@ -1370,7 +1477,7 @@ mbc_free(Allctr_t *allctr, void *p) ASSERT(p); blk = UMEM2BLK(p); - blk_sz = BLK_SZ(blk); + blk_sz = MBC_ABLK_SZ(blk); if (blk_sz < allctr->sbmbc_threshold) alcu_flgs |= ERTS_ALCU_FLG_SBMBC; @@ -1381,17 +1488,18 @@ mbc_free(Allctr_t *allctr, void *p) STAT_MBC_BLK_FREE(allctr, blk_sz, alcu_flgs); - is_first_blk = IS_FIRST_BLK(blk); + is_first_blk = IS_MBC_FIRST_ABLK(allctr, blk); is_last_blk = IS_LAST_BLK(blk); - if (!is_first_blk && IS_PREV_BLK_FREE(blk)) { + if (IS_PREV_BLK_FREE(blk)) { + ASSERT(!is_first_blk); /* Coalesce with previous block... */ blk = PREV_BLK(blk); (*allctr->unlink_free_block)(allctr, blk, alcu_flgs); - blk_sz += BLK_SZ(blk); - is_first_blk = IS_FIRST_BLK(blk); - SET_BLK_SZ(blk, blk_sz); + blk_sz += MBC_FBLK_SZ(blk); + is_first_blk = IS_MBC_FIRST_FBLK(allctr, blk); + SET_MBC_FBLK_SZ(blk, blk_sz); } else { SET_BLK_FREE(blk); @@ -1400,12 +1508,12 @@ mbc_free(Allctr_t *allctr, void *p) if (is_last_blk) SET_LAST_BLK(blk); else { - nxt_blk = NXT_BLK(blk); + nxt_blk = BLK_AFTER(blk, blk_sz); if (IS_FREE_BLK(nxt_blk)) { /* Coalesce with next block... */ (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); - blk_sz += BLK_SZ(nxt_blk); - SET_BLK_SZ(blk, blk_sz); + blk_sz += MBC_FBLK_SZ(nxt_blk); + SET_MBC_FBLK_SZ(blk, blk_sz); is_last_blk = IS_LAST_BLK(nxt_blk); if (is_last_blk) @@ -1416,26 +1524,26 @@ mbc_free(Allctr_t *allctr, void *p) } } else { - SET_PREV_BLK_FREE(nxt_blk); + SET_PREV_BLK_FREE(allctr, nxt_blk); SET_NOT_LAST_BLK(blk); SET_BLK_SZ_FTR(blk, blk_sz); } } - ASSERT(is_last_blk ? IS_LAST_BLK(blk) : IS_NOT_LAST_BLK(blk)); - ASSERT(is_first_blk ? IS_FIRST_BLK(blk) : IS_NOT_FIRST_BLK(blk)); ASSERT(IS_FREE_BLK(blk)); + ASSERT(!is_last_blk == !IS_LAST_BLK(blk)); + ASSERT(!is_first_blk == !IS_MBC_FIRST_FBLK(allctr, blk)); ASSERT(is_first_blk || IS_PREV_BLK_ALLOCED(blk)); ASSERT(is_last_blk || IS_PREV_BLK_FREE(NXT_BLK(blk))); - ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz == MBC_BLK_SZ(blk)); ASSERT(is_last_blk || blk == PREV_BLK(NXT_BLK(blk))); ASSERT(blk_sz % sizeof(Unit_t) == 0); ASSERT(IS_MBC_BLK(blk)); if (is_first_blk && is_last_blk - && allctr->main_carrier != FBLK2MBC(allctr, blk)) { + && allctr->main_carrier != FIRST_BLK_TO_MBC(allctr, blk)) { if (alcu_flgs & ERTS_ALCU_FLG_SBMBC) destroy_sbmbc(allctr, blk); else @@ -1472,7 +1580,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) ASSERT(size < allctr->sbc_threshold); blk = (Block_t *) UMEM2BLK(p); - old_blk_sz = BLK_SZ(blk); + old_blk_sz = MBC_ABLK_SZ(blk); ASSERT(old_blk_sz >= allctr->min_block_size); @@ -1497,6 +1605,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) return p; else if (blk_sz < old_blk_sz) { /* Shrink block... */ + Carrier_t* crr; Block_t *nxt_nxt_blk; Uint diff_sz_val = old_blk_sz - blk_sz; Uint old_blk_sz_val = old_blk_sz; @@ -1516,16 +1625,18 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) return NULL; cand_blk_sz = old_blk_sz; - if (!IS_PREV_BLK_FREE(blk) || IS_FIRST_BLK(blk)) + if (!IS_PREV_BLK_FREE(blk)) { cand_blk = blk; + } else { + ASSERT(!IS_MBC_FIRST_ABLK(allctr, blk)); cand_blk = PREV_BLK(blk); cand_blk_sz += PREV_BLK_SZ(blk); } if (!is_last_blk) { - nxt_blk = NXT_BLK(blk); + nxt_blk = BLK_AFTER(blk, old_blk_sz); if (IS_FREE_BLK(nxt_blk)) - cand_blk_sz += BLK_SZ(nxt_blk); + cand_blk_sz += MBC_FBLK_SZ(nxt_blk); } new_blk = (*allctr->get_free_block)(allctr, @@ -1541,52 +1652,48 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) nxt_blk_sz = old_blk_sz - blk_sz; - if ((is_last_blk || IS_ALLOCED_BLK(NXT_BLK(blk))) + if ((is_last_blk || IS_ALLOCED_BLK(BLK_AFTER(blk,old_blk_sz))) && (nxt_blk_sz < allctr->min_block_size)) return p; HARD_CHECK_BLK_CARRIER(allctr, blk); - SET_BLK_SZ(blk, blk_sz); + nxt_nxt_blk = BLK_AFTER(blk, old_blk_sz); + + SET_MBC_ABLK_SZ(blk, blk_sz); SET_NOT_LAST_BLK(blk); - nxt_blk = NXT_BLK(blk); - SET_BLK_HDR(nxt_blk, - nxt_blk_sz, - SBH_THIS_FREE|SBH_PREV_ALLOCED|SBH_NOT_LAST_BLK); + nxt_blk = BLK_AFTER(blk, blk_sz); STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); - ASSERT(BLK_SZ(blk) >= allctr->min_block_size); + ASSERT(MBC_BLK_SZ(blk) >= allctr->min_block_size); - if (is_last_blk) - SET_LAST_BLK(nxt_blk); - else { - nxt_nxt_blk = NXT_BLK(nxt_blk); + if (!is_last_blk) { if (IS_FREE_BLK(nxt_nxt_blk)) { /* Coalesce with next free block... */ - nxt_blk_sz += BLK_SZ(nxt_nxt_blk); + nxt_blk_sz += MBC_FBLK_SZ(nxt_nxt_blk); (*allctr->unlink_free_block)(allctr, nxt_nxt_blk, alcu_flgs); - SET_BLK_SZ(nxt_blk, nxt_blk_sz); - is_last_blk = IS_LAST_BLK(nxt_nxt_blk); - if (is_last_blk) - SET_LAST_BLK(nxt_blk); - else - SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); + is_last_blk = GET_LAST_BLK_HDR_FLG(nxt_nxt_blk); } else { - SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); - SET_PREV_BLK_FREE(nxt_nxt_blk); + SET_PREV_BLK_FREE(allctr, nxt_nxt_blk); } + SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); } + crr = ABLK_TO_MBC(blk); + SET_MBC_FBLK_HDR(nxt_blk, nxt_blk_sz, + SBH_THIS_FREE | (is_last_blk ? SBH_LAST_BLK : 0), + crr); + (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); - ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz == MBC_BLK_SZ(blk)); ASSERT(blk_sz % sizeof(Unit_t) == 0); ASSERT(blk_sz >= allctr->min_block_size); ASSERT(blk_sz >= size + ABLK_HDR_SZ); @@ -1594,14 +1701,15 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) ASSERT(IS_FREE_BLK(nxt_blk)); ASSERT(IS_PREV_BLK_ALLOCED(nxt_blk)); - ASSERT(nxt_blk_sz == BLK_SZ(nxt_blk)); + ASSERT(nxt_blk_sz == MBC_BLK_SZ(nxt_blk)); ASSERT(nxt_blk_sz % sizeof(Unit_t) == 0); ASSERT(nxt_blk_sz >= allctr->min_block_size); ASSERT(IS_MBC_BLK(nxt_blk)); ASSERT(is_last_blk ? IS_LAST_BLK(nxt_blk) : IS_NOT_LAST_BLK(nxt_blk)); ASSERT(is_last_blk || nxt_blk == PREV_BLK(NXT_BLK(nxt_blk))); ASSERT(is_last_blk || IS_PREV_BLK_FREE(NXT_BLK(nxt_blk))); - + ASSERT(FBLK_TO_MBC(nxt_blk) == crr); + HARD_CHECK_BLK_CARRIER(allctr, blk); return p; @@ -1610,8 +1718,8 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) /* Need larger block... */ if (!is_last_blk) { - nxt_blk = NXT_BLK(blk); - nxt_blk_sz = BLK_SZ(nxt_blk); + nxt_blk = BLK_AFTER(blk, old_blk_sz); + nxt_blk_sz = MBC_BLK_SZ(nxt_blk); if (IS_FREE_BLK(nxt_blk) && get_blk_sz <= old_blk_sz + nxt_blk_sz) { /* Grow into next block... */ @@ -1624,7 +1732,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (nxt_blk_sz < allctr->min_block_size) { blk_sz += nxt_blk_sz; - SET_BLK_SZ(blk, blk_sz); + SET_MBC_ABLK_SZ(blk, blk_sz); if (is_last_blk) { SET_LAST_BLK(blk); @@ -1633,21 +1741,20 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) #endif } else { - nxt_blk = NXT_BLK(blk); + nxt_blk = BLK_AFTER(blk, blk_sz); SET_PREV_BLK_ALLOCED(nxt_blk); #ifdef DEBUG is_last_blk = IS_LAST_BLK(nxt_blk); - nxt_blk_sz = BLK_SZ(nxt_blk); + nxt_blk_sz = MBC_BLK_SZ(nxt_blk); #endif } } else { - SET_BLK_SZ(blk, blk_sz); + Carrier_t* crr = ABLK_TO_MBC(blk); + SET_MBC_ABLK_SZ(blk, blk_sz); - nxt_blk = NXT_BLK(blk); - SET_BLK_HDR(nxt_blk, - nxt_blk_sz, - SBH_THIS_FREE|SBH_PREV_ALLOCED|SBH_NOT_LAST_BLK); + nxt_blk = BLK_AFTER(blk, blk_sz); + SET_MBC_FBLK_HDR(nxt_blk, nxt_blk_sz, SBH_THIS_FREE, crr); if (is_last_blk) SET_LAST_BLK(nxt_blk); @@ -1657,6 +1764,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); ASSERT(IS_FREE_BLK(nxt_blk)); + ASSERT(FBLK_TO_MBC(nxt_blk) == crr); } STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); @@ -1664,14 +1772,14 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) ASSERT(IS_ALLOCED_BLK(blk)); - ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz == MBC_BLK_SZ(blk)); ASSERT(blk_sz % sizeof(Unit_t) == 0); ASSERT(blk_sz >= allctr->min_block_size); ASSERT(blk_sz >= size + ABLK_HDR_SZ); ASSERT(IS_MBC_BLK(blk)); ASSERT(!nxt_blk || IS_PREV_BLK_ALLOCED(nxt_blk)); - ASSERT(!nxt_blk || nxt_blk_sz == BLK_SZ(nxt_blk)); + ASSERT(!nxt_blk || nxt_blk_sz == MBC_BLK_SZ(nxt_blk)); ASSERT(!nxt_blk || nxt_blk_sz % sizeof(Unit_t) == 0); ASSERT(!nxt_blk || nxt_blk_sz >= allctr->min_block_size); ASSERT(!nxt_blk || IS_MBC_BLK(nxt_blk)); @@ -1696,18 +1804,19 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) /* Need to grow in another block */ - if (!IS_PREV_BLK_FREE(blk) || IS_FIRST_BLK(blk)) { + if (!IS_PREV_BLK_FREE(blk)) { cand_blk = NULL; cand_blk_sz = 0; } else { + ASSERT(!IS_MBC_FIRST_ABLK(allctr, blk)); cand_blk = PREV_BLK(blk); cand_blk_sz = old_blk_sz + PREV_BLK_SZ(blk); if (!is_last_blk) { - nxt_blk = NXT_BLK(blk); + nxt_blk = BLK_AFTER(blk, old_blk_sz); if (IS_FREE_BLK(nxt_blk)) - cand_blk_sz += BLK_SZ(nxt_blk); + cand_blk_sz += MBC_FBLK_SZ(nxt_blk); } } @@ -1743,8 +1852,9 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (new_blk) { mbc_alloc_finalize(allctr, new_blk, - BLK_SZ(new_blk), + MBC_FBLK_SZ(new_blk), GET_BLK_HDR_FLGS(new_blk), + FBLK_TO_MBC(new_blk), blk_sz, 1, alcu_flgs); @@ -1754,6 +1864,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) return new_p; } else { + Carrier_t* crr; Uint new_blk_sz; UWord new_blk_flgs; Uint prev_blk_sz; @@ -1774,10 +1885,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (is_last_blk) new_blk_flgs |= LAST_BLK_HDR_FLG; else { - nxt_blk = NXT_BLK(blk); + nxt_blk = BLK_AFTER(blk, old_blk_sz); if (IS_FREE_BLK(nxt_blk)) { new_blk_flgs |= GET_LAST_BLK_HDR_FLG(nxt_blk); - new_blk_sz += BLK_SZ(nxt_blk); + new_blk_sz += MBC_FBLK_SZ(nxt_blk); (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); } } @@ -1790,6 +1901,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) new_p = BLK2UMEM(new_blk); blk_cpy_sz = MIN(blk_sz, old_blk_sz); + crr = FBLK_TO_MBC(new_blk); if (prev_blk_sz >= blk_cpy_sz) sys_memcpy(new_p, p, blk_cpy_sz - ABLK_HDR_SZ); @@ -1800,6 +1912,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) new_blk, new_blk_sz, new_blk_flgs, + crr, blk_sz, 0, alcu_flgs); @@ -1815,35 +1928,40 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) #ifdef DEBUG #if HAVE_ERTS_MSEG -#define ASSERT_MSEG_UNIT_SIZE_MULTIPLE(CSZ) ASSERT((CSZ) % mseg_unit_size == 0) +#define ASSERT_MSEG_UNIT_SIZE_MULTIPLE(CSZ) ASSERT((CSZ) % MSEG_UNIT_SZ == 0) #else #define ASSERT_MSEG_UNIT_SIZE_MULTIPLE(CSZ) #endif -#define CHECK_1BLK_CARRIER(A, SBC, MSEGED, C, CSZ, B, BSZ) \ -do { \ - ASSERT(IS_FIRST_BLK((B))); \ - ASSERT(IS_LAST_BLK((B))); \ - ASSERT((CSZ) == CARRIER_SZ((C))); \ - ASSERT((BSZ) == BLK_SZ((B))); \ - ASSERT((BSZ) % sizeof(Unit_t) == 0); \ - if ((SBC)) { \ - ASSERT(IS_SBC_BLK((B))); \ - ASSERT(IS_SB_CARRIER((C))); \ - } \ - else { \ - ASSERT(IS_MBC_BLK((B))); \ - ASSERT(IS_MB_CARRIER((C))); \ - } \ - if ((MSEGED)) { \ - ASSERT(IS_MSEG_CARRIER((C))); \ - ASSERT_MSEG_UNIT_SIZE_MULTIPLE((CSZ)); \ - } \ - else { \ - ASSERT(IS_SYS_ALLOC_CARRIER((C))); \ - ASSERT((CSZ) % sizeof(Unit_t) == 0); \ - } \ -} while (0) +static void CHECK_1BLK_CARRIER(Allctr_t* A, int SBC, int MSEGED, Carrier_t* C, + UWord CSZ, Block_t* B, UWord BSZ) +{ + ASSERT(IS_LAST_BLK((B))); + ASSERT((CSZ) == CARRIER_SZ((C))); + ASSERT((BSZ) % sizeof(Unit_t) == 0); + if ((SBC)) { + ASSERT((BSZ) == SBC_BLK_SZ((B))); + ASSERT((char*)B == (char*)C + SBC_HEADER_SIZE); + ASSERT(IS_SBC_BLK((B))); + ASSERT(IS_SB_CARRIER((C))); + } + else { + ASSERT(IS_FREE_BLK(B)); + ASSERT((BSZ) == MBC_FBLK_SZ((B))); + ASSERT(IS_MBC_FIRST_FBLK(A, (B))); + ASSERT(IS_MBC_BLK((B))); + ASSERT(IS_MB_CARRIER((C))); + ASSERT(FBLK_TO_MBC(B) == (C)); + } + if ((MSEGED)) { + ASSERT(IS_MSEG_CARRIER((C))); + ASSERT_MSEG_UNIT_SIZE_MULTIPLE((CSZ)); + } + else { + ASSERT(IS_SYS_ALLOC_CARRIER((C))); + ASSERT((CSZ) % sizeof(Unit_t) == 0); + } +} #else #define CHECK_1BLK_CARRIER(A, SBC, MSEGED, C, CSZ, B, BSZ) @@ -1865,37 +1983,18 @@ create_sbmbc(Allctr_t *allctr, Uint umem_sz) crr = erts_alloc(ERTS_ALC_T_SBMBC, crr_sz); INC_CC(allctr->calls.sbmbc_alloc); - SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC); - - blk = MBC2FBLK(allctr, crr); + SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC, allctr); -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz -= sizeof(UWord); -#endif + blk = MBC_TO_FIRST_BLK(allctr, crr); - blk_sz = UNIT_FLOOR(crr_sz - allctr->mbc_header_size); + blk_sz = UNIT_FLOOR(crr_sz - MBC_HEADER_SIZE(allctr)); - SET_MBC_BLK_FTR(((UWord *) blk)[-1]); - SET_BLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_PREV_FREE|SBH_LAST_BLK); - -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - *((Carrier_t **) NXT_BLK(blk)) = crr; -#endif + SET_MBC_FBLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_LAST_BLK, crr); link_carrier(&allctr->sbmbc_list, crr); -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz += sizeof(UWord); -#endif - STAT_SBMBC_ALLOC(allctr, crr_sz); CHECK_1BLK_CARRIER(allctr, 0, 0, crr, crr_sz, blk, blk_sz); -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz -= sizeof(UWord); -#endif if (allctr->creating_mbc) (*allctr->creating_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC); @@ -1909,11 +2008,10 @@ destroy_sbmbc(Allctr_t *allctr, Block_t *blk) Uint crr_sz; Carrier_t *crr; - ASSERT(IS_FIRST_BLK(blk)); - ASSERT(IS_MBC_BLK(blk)); + ASSERT(IS_MBC_FIRST_FBLK(allctr, blk)); - crr = FBLK2MBC(allctr, blk); + crr = FIRST_BLK_TO_MBC(allctr, blk); crr_sz = CARRIER_SZ(crr); #ifdef DEBUG @@ -1952,14 +2050,25 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) Uint blk_sz, bcrr_sz, crr_sz; #if HAVE_ERTS_MSEG int have_tried_sys_alloc = 0, have_tried_mseg = 0; + Uint mseg_flags; #endif #ifdef DEBUG int is_mseg = 0; #endif +#if HALFWORD_HEAP + flags |= CFLG_FORCE_MSEG; +#elif HAVE_SUPER_ALIGNED_MB_CARRIERS + if (flags & CFLG_MBC) { + flags |= CFLG_FORCE_MSEG; + } +#endif + ASSERT((flags & CFLG_SBC && !(flags & CFLG_MBC)) || (flags & CFLG_MBC && !(flags & CFLG_SBC))); + ASSERT(!(flags & CFLG_FORCE_MSEG && flags & CFLG_FORCE_SYS_ALLOC)); + blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); #if HAVE_ERTS_MSEG @@ -1974,29 +2083,27 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) if (allctr->sbcs.curr.norm.mseg.no >= allctr->max_mseg_sbcs) goto try_sys_alloc; } +#if !HAVE_SUPER_ALIGNED_MB_CARRIERS else { if (allctr->mbcs.curr.norm.mseg.no >= allctr->max_mseg_mbcs) goto try_sys_alloc; } +#endif try_mseg: if (flags & CFLG_SBC) { - crr_sz = blk_sz + allctr->sbc_header_size; + crr_sz = blk_sz + SBC_HEADER_SIZE; + mseg_flags = ERTS_MSEG_FLG_NONE; } else { crr_sz = (*allctr->get_next_mbc_size)(allctr); - if (crr_sz < allctr->mbc_header_size + blk_sz) - crr_sz = allctr->mbc_header_size + blk_sz; -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz += sizeof(UWord); -#endif + if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz) + crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; + mseg_flags = ERTS_MSEG_FLG_2POW; } - crr_sz = MSEG_UNIT_CEILING(crr_sz); - ASSERT(crr_sz % mseg_unit_size == 0); - crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz); + crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz, mseg_flags); if (!crr) { have_tried_mseg = 1; if (!(have_tried_sys_alloc || flags & CFLG_FORCE_MSEG)) @@ -2008,32 +2115,31 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) is_mseg = 1; #endif if (flags & CFLG_SBC) { - SET_CARRIER_HDR(crr, crr_sz, SCH_MSEG|SCH_SBC); + SET_CARRIER_HDR(crr, crr_sz, SCH_MSEG|SCH_SBC, allctr); STAT_MSEG_SBC_ALLOC(allctr, crr_sz, blk_sz); goto sbc_final_touch; } else { - SET_CARRIER_HDR(crr, crr_sz, SCH_MSEG|SCH_MBC); +#ifndef ARCH_64 + ASSERT(crr_sz <= MBC_SZ_MAX_LIMIT); +#endif + SET_CARRIER_HDR(crr, crr_sz, SCH_MSEG|SCH_MBC, allctr); STAT_MSEG_MBC_ALLOC(allctr, crr_sz); goto mbc_final_touch; } try_sys_alloc: + #endif /* #if HAVE_ERTS_MSEG */ if (flags & CFLG_SBC) { - bcrr_sz = blk_sz + allctr->sbc_header_size; + bcrr_sz = blk_sz + SBC_HEADER_SIZE; } else { - bcrr_sz = allctr->mbc_header_size + blk_sz; + bcrr_sz = MBC_HEADER_SIZE(allctr) + blk_sz; if (!(flags & CFLG_MAIN_CARRIER) && bcrr_sz < allctr->smallest_mbc_size) bcrr_sz = allctr->smallest_mbc_size; -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - bcrr_sz += sizeof(UWord); -#endif - } crr_sz = (flags & CFLG_FORCE_SIZE @@ -2057,7 +2163,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) } } if (flags & CFLG_SBC) { - SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_SBC); + SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_SBC, allctr); STAT_SYS_ALLOC_SBC_ALLOC(allctr, crr_sz, blk_sz); #if HAVE_ERTS_MSEG @@ -2066,8 +2172,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) blk = SBC2BLK(allctr, crr); - SET_SBC_BLK_FTR(((UWord *) blk)[-1]); - SET_BLK_HDR(blk, blk_sz, SBH_THIS_ALLOCED|SBH_PREV_FREE|SBH_LAST_BLK); + SET_SBC_BLK_HDR(blk, blk_sz); link_carrier(&allctr->sbc_list, crr); @@ -2075,28 +2180,18 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) } else { - SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC); + SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC, allctr); STAT_SYS_ALLOC_MBC_ALLOC(allctr, crr_sz); #if HAVE_ERTS_MSEG mbc_final_touch: #endif - blk = MBC2FBLK(allctr, crr); - -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz -= sizeof(UWord); -#endif - - blk_sz = UNIT_FLOOR(crr_sz - allctr->mbc_header_size); + blk = MBC_TO_FIRST_BLK(allctr, crr); - SET_MBC_BLK_FTR(((UWord *) blk)[-1]); - SET_BLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_PREV_FREE|SBH_LAST_BLK); + blk_sz = UNIT_FLOOR(crr_sz - MBC_HEADER_SIZE(allctr)); -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - *((Carrier_t **) NXT_BLK(blk)) = crr; -#endif + SET_MBC_FBLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_LAST_BLK, crr); if (flags & CFLG_MAIN_CARRIER) { ASSERT(!allctr->main_carrier); @@ -2105,15 +2200,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) link_carrier(&allctr->mbc_list, crr); -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz += sizeof(UWord); -#endif CHECK_1BLK_CARRIER(allctr, 0, is_mseg, crr, crr_sz, blk, blk_sz); -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - if (allctr->mbc_header_size % sizeof(Unit_t) == 0) - crr_sz -= sizeof(UWord); -#endif if (allctr->creating_mbc) (*allctr->creating_mbc)(allctr, crr, 0); @@ -2142,8 +2229,8 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) HARD_CHECK_BLK_CARRIER(allctr, old_blk); - old_blk_sz = BLK_SZ(old_blk); - old_crr = BLK2SBC(allctr, old_blk); + old_blk_sz = SBC_BLK_SZ(old_blk); + old_crr = BLK_TO_SBC(old_blk); old_crr_sz = CARRIER_SZ(old_crr); ASSERT(IS_SB_CARRIER(old_crr)); ASSERT(IS_SBC_BLK(old_blk)); @@ -2157,7 +2244,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) if (!(flags & CFLG_FORCE_SYS_ALLOC)) { - new_crr_sz = new_blk_sz + allctr->sbc_header_size; + new_crr_sz = new_blk_sz + SBC_HEADER_SIZE; new_crr_sz = MSEG_UNIT_CEILING(new_crr_sz); new_crr = (Carrier_t *) alcu_mseg_realloc(allctr, old_crr, @@ -2166,7 +2253,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) if (new_crr) { SET_CARRIER_SZ(new_crr, new_crr_sz); new_blk = SBC2BLK(allctr, new_crr); - SET_BLK_SZ(new_blk, new_blk_sz); + SET_SBC_BLK_SZ(new_blk, new_blk_sz); STAT_MSEG_SBC_ALLOC(allctr, new_crr_sz, new_blk_sz); relink_carrier(&allctr->sbc_list, new_crr); CHECK_1BLK_CARRIER(allctr, 1, 1, new_crr, new_crr_sz, @@ -2174,6 +2261,11 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) DEBUG_SAVE_ALIGNMENT(new_crr); return new_blk; } +#if HALFWORD_HEAP + /* Old carrier unchanged; restore stat */ + STAT_MSEG_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz); + return NULL; +#endif create_flags |= CFLG_FORCE_SYS_ALLOC; /* since mseg_realloc() failed */ } @@ -2196,7 +2288,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) else { if (!(flags & CFLG_FORCE_MSEG)) { #endif /* #if HAVE_ERTS_MSEG */ - new_bcrr_sz = new_blk_sz + allctr->sbc_header_size; + new_bcrr_sz = new_blk_sz + SBC_HEADER_SIZE; new_crr_sz = (flags & CFLG_FORCE_SIZE ? UNIT_CEILING(new_bcrr_sz) : SYS_ALLOC_CARRIER_CEILING(new_bcrr_sz)); @@ -2208,7 +2300,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) sys_realloc_success: SET_CARRIER_SZ(new_crr, new_crr_sz); new_blk = SBC2BLK(allctr, new_crr); - SET_BLK_SZ(new_blk, new_blk_sz); + SET_SBC_BLK_SZ(new_blk, new_blk_sz); STAT_SYS_ALLOC_SBC_FREE(allctr, old_crr_sz, old_blk_sz); STAT_SYS_ALLOC_SBC_ALLOC(allctr, new_crr_sz, new_blk_sz); relink_carrier(&allctr->sbc_list, new_crr); @@ -2218,7 +2310,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) return new_blk; } else if (new_crr_sz > UNIT_CEILING(new_bcrr_sz)) { - new_crr_sz = new_blk_sz + allctr->sbc_header_size; + new_crr_sz = new_blk_sz + SBC_HEADER_SIZE; new_crr_sz = UNIT_CEILING(new_crr_sz); new_crr = (Carrier_t *) alcu_sys_realloc(allctr, (void *) old_crr, @@ -2262,11 +2354,9 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) Uint is_mseg = 0; #endif - ASSERT(IS_FIRST_BLK(blk)); - if (IS_SBC_BLK(blk)) { - Uint blk_sz = BLK_SZ(blk); - crr = BLK2SBC(allctr, blk); + Uint blk_sz = SBC_BLK_SZ(blk); + crr = BLK_TO_SBC(blk); crr_sz = CARRIER_SZ(crr); ASSERT(IS_LAST_BLK(blk)); @@ -2276,7 +2366,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) #if HAVE_ERTS_MSEG if (IS_MSEG_CARRIER(crr)) { is_mseg++; - ASSERT(crr_sz % mseg_unit_size == 0); + ASSERT(crr_sz % MSEG_UNIT_SZ == 0); STAT_MSEG_SBC_FREE(allctr, crr_sz, blk_sz); } else @@ -2287,7 +2377,8 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) } else { - crr = FBLK2MBC(allctr, blk); + ASSERT(IS_MBC_FIRST_FBLK(allctr, blk)); + crr = FIRST_BLK_TO_MBC(allctr, blk); crr_sz = CARRIER_SZ(crr); #ifdef DEBUG @@ -2305,7 +2396,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) #if HAVE_ERTS_MSEG if (IS_MSEG_CARRIER(crr)) { is_mseg++; - ASSERT(crr_sz % mseg_unit_size == 0); + ASSERT(crr_sz % MSEG_UNIT_SZ == 0); STAT_MSEG_MBC_FREE(allctr, crr_sz); } else @@ -3430,12 +3521,7 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) if (allctr->dd.use) ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); #endif -#if HALFWORD_HEAP - blk = create_carrier(allctr, size, - CFLG_SBC | CFLG_FORCE_MSEG); -#else blk = create_carrier(allctr, size, CFLG_SBC); -#endif res = blk ? BLK2UMEM(blk) : NULL; } else @@ -3506,24 +3592,20 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size) void * erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) { - int pref_ix; Allctr_t *pref_allctr; void *res; - pref_ix = get_pref_allctr(extra, &pref_allctr); + pref_allctr = get_pref_allctr(extra); if (pref_allctr->thread_safe) erts_mtx_lock(&pref_allctr->mutex); ERTS_ALCU_DBG_CHK_THR_ACCESS(pref_allctr); - res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord)); + res = do_erts_alcu_alloc(type, pref_allctr, size); if (pref_allctr->thread_safe) erts_mtx_unlock(&pref_allctr->mutex); - if (res) - res = put_used_allctr(res, pref_ix, size); - DEBUG_CHECK_ALIGNMENT(res); @@ -3644,21 +3726,20 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p) { if (p) { Allctr_t *pref_allctr, *used_allctr; - void *ptr; - get_pref_allctr(extra, &pref_allctr); - ptr = get_used_allctr(extra, p, &used_allctr, NULL); + pref_allctr = get_pref_allctr(extra); + used_allctr = get_used_allctr(extra, p, NULL); if (pref_allctr != used_allctr) enqueue_dealloc_other_instance(type, used_allctr, - ptr, + p, (used_allctr->dd.ix - pref_allctr->dd.ix)); else { if (used_allctr->thread_safe) erts_mtx_lock(&used_allctr->mutex); ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr); - do_erts_alcu_free(type, used_allctr, ptr); + do_erts_alcu_free(type, used_allctr, p); if (used_allctr->thread_safe) erts_mtx_unlock(&used_allctr->mutex); } @@ -3739,13 +3820,13 @@ do_erts_alcu_realloc(ErtsAlcType_t type, if (IS_MBC_BLK(blk)) res = mbc_realloc(allctr, p, size, alcu_flgs); else { - Uint used_sz = allctr->sbc_header_size + ABLK_HDR_SZ + size; + Uint used_sz = SBC_HEADER_SIZE + ABLK_HDR_SZ + size; Uint crr_sz; Uint diff_sz_val; Uint crr_sz_val; #if HAVE_ERTS_MSEG - if (IS_SYS_ALLOC_CARRIER(BLK2SBC(allctr, blk))) + if (IS_SYS_ALLOC_CARRIER(BLK_TO_SBC(blk))) #endif crr_sz = SYS_ALLOC_CARRIER_CEILING(used_sz); #if HAVE_ERTS_MSEG @@ -3775,7 +3856,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, if (res) { sys_memcpy((void*) res, (void*) p, - MIN(BLK_SZ(blk) - ABLK_HDR_SZ, size)); + MIN(SBC_BLK_SZ(blk) - ABLK_HDR_SZ, size)); destroy_carrier(allctr, blk); } } @@ -3798,16 +3879,12 @@ do_erts_alcu_realloc(ErtsAlcType_t type, else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; else { -#if HALFWORD_HEAP - new_blk = create_carrier(allctr, size, CFLG_SBC | CFLG_FORCE_MSEG); -#else new_blk = create_carrier(allctr, size, CFLG_SBC); -#endif if (new_blk) { res = BLK2UMEM(new_blk); sys_memcpy((void *) res, (void *) p, - MIN(BLK_SZ(blk) - ABLK_HDR_SZ, size)); + MIN(MBC_ABLK_SZ(blk) - ABLK_HDR_SZ, size)); mbc_free(allctr, p); } else @@ -3966,16 +4043,15 @@ static ERTS_INLINE void * realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size, int force_move) { - int pref_ix; - void *ptr, *res; + void *res; Allctr_t *pref_allctr, *used_allctr; UWord old_user_size; if (!p) return erts_alcu_alloc_thr_pref(type, extra, size); - pref_ix = get_pref_allctr(extra, &pref_allctr); - ptr = get_used_allctr(extra, p, &used_allctr, &old_user_size); + pref_allctr = get_pref_allctr(extra); + used_allctr = get_used_allctr(extra, p, &old_user_size); ASSERT(used_allctr && pref_allctr); @@ -3985,56 +4061,33 @@ realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size, ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr); res = do_erts_alcu_realloc(type, used_allctr, - ptr, - size + sizeof(UWord), + p, + size, 0); if (used_allctr->thread_safe) erts_mtx_unlock(&used_allctr->mutex); - if (res) - res = put_used_allctr(res, pref_ix, size); } else { if (pref_allctr->thread_safe) erts_mtx_lock(&pref_allctr->mutex); - res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(UWord)); - if (pref_allctr->thread_safe && (!force_move - || used_allctr != pref_allctr)) + res = do_erts_alcu_alloc(type, pref_allctr, size); + if (pref_allctr->thread_safe && used_allctr != pref_allctr) { erts_mtx_unlock(&pref_allctr->mutex); + } if (res) { - Block_t *blk; - size_t cpy_size; - - res = put_used_allctr(res, pref_ix, size); - DEBUG_CHECK_ALIGNMENT(res); - blk = UMEM2BLK(ptr); - if (old_user_size != ERTS_AU_PREF_ALLOC_SIZE_MASK) - cpy_size = old_user_size; - else { - if (used_allctr->thread_safe && (!force_move - || used_allctr != pref_allctr)) - erts_mtx_lock(&used_allctr->mutex); - ERTS_SMP_LC_ASSERT(!used_allctr->thread_safe || - erts_lc_mtx_is_locked(&used_allctr->mutex)); - cpy_size = BLK_SZ(blk); - if (used_allctr->thread_safe && (!force_move - || used_allctr != pref_allctr)) - erts_mtx_unlock(&used_allctr->mutex); - cpy_size -= ABLK_HDR_SZ + sizeof(UWord); - } - if (cpy_size > size) - cpy_size = size; - sys_memcpy(res, p, cpy_size); + sys_memcpy(res, p, MIN(size,old_user_size)); - if (!force_move || used_allctr != pref_allctr) + if (used_allctr != pref_allctr) { enqueue_dealloc_other_instance(type, used_allctr, - ptr, + p, (used_allctr->dd.ix - pref_allctr->dd.ix)); + } else { - do_erts_alcu_free(type, used_allctr, ptr); + do_erts_alcu_free(type, used_allctr, p); ASSERT(pref_allctr == used_allctr); if (pref_allctr->thread_safe) erts_mtx_unlock(&pref_allctr->mutex); @@ -4111,7 +4164,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->ramv = init->ramv; allctr->main_carrier_size = init->mmbcs; - allctr->sbc_threshold = init->sbct; + #if HAVE_ERTS_MSEG allctr->mseg_opt.abs_shrink_th = init->asbcst; allctr->mseg_opt.rel_shrink_th = init->rsbcst; @@ -4120,20 +4173,29 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->mbc_move_threshold = init->rmbcmt; #if HAVE_ERTS_MSEG allctr->max_mseg_sbcs = init->mmsbc; +# if HAVE_SUPER_ALIGNED_MB_CARRIERS + allctr->max_mseg_mbcs = ~(Uint)0; +# else allctr->max_mseg_mbcs = init->mmmbc; +# endif #endif allctr->largest_mbc_size = MAX(init->lmbcs, init->smbcs); +#ifndef ARCH_64 + if (allctr->largest_mbc_size > MBC_SZ_MAX_LIMIT) { + allctr->largest_mbc_size = MBC_SZ_MAX_LIMIT; + } +#endif allctr->smallest_mbc_size = init->smbcs; allctr->mbc_growth_stages = MAX(1, init->mbcgs); if (allctr->min_block_size < ABLK_HDR_SZ) goto error; allctr->min_block_size = UNIT_CEILING(allctr->min_block_size - + sizeof(UWord)); + + sizeof(FreeBlkFtr_t)); #if ERTS_SMP if (init->tpref) { - Uint sz = sizeof(Block_t); + Uint sz = ABLK_HDR_SZ; sz += ERTS_ALCU_DD_FIX_TYPE_OFFS*sizeof(UWord); if (init->fix) sz += sizeof(UWord); @@ -4143,6 +4205,23 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) } #endif + allctr->sbc_threshold = init->sbct; +#ifndef ARCH_64 + if (allctr->sbc_threshold > 0) { + Uint max_mbc_block_sz = UNIT_CEILING(allctr->sbc_threshold - 1 + ABLK_HDR_SZ); + if (max_mbc_block_sz + UNIT_FLOOR(allctr->min_block_size - 1) > MBC_ABLK_SZ_MASK + || max_mbc_block_sz < allctr->sbc_threshold) { /* wrap around */ + /* + * By limiting sbc_threshold to (hard limit - min_block_size) + * we avoid having to split off free "residue blocks" + * smaller than min_block_size. + */ + max_mbc_block_sz = MBC_ABLK_SZ_MASK - UNIT_FLOOR(allctr->min_block_size - 1); + allctr->sbc_threshold = max_mbc_block_sz - ABLK_HDR_SZ + 1; + } + } +#endif + allctr->sbmbc_threshold = init->sbmbct; @@ -4158,7 +4237,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->sbmbc_size = init->sbmbcs; min_size = allctr->sbmbc_threshold; min_size += allctr->min_block_size; - min_size += allctr->mbc_header_size; + min_size += MBC_HEADER_SIZE(allctr); if (allctr->sbmbc_size < min_size) allctr->sbmbc_size = min_size; } @@ -4203,59 +4282,26 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (!allctr->get_next_mbc_size) allctr->get_next_mbc_size = get_next_mbc_size; - if (allctr->mbc_header_size < sizeof(Carrier_t)) - goto error; #ifdef ERTS_SMP allctr->dd.use = 0; if (init->tpref) { - allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size - + FBLK_FTR_SZ - + ABLK_HDR_SZ - + sizeof(UWord)) - - ABLK_HDR_SZ - - sizeof(UWord)); - allctr->sbc_header_size = (UNIT_CEILING(sizeof(Carrier_t) - + FBLK_FTR_SZ - + ABLK_HDR_SZ - + sizeof(UWord)) - - ABLK_HDR_SZ - - sizeof(UWord)); - allctr->dd.use = 1; init_dd_queue(&allctr->dd.q); allctr->dd.ix = init->ix; } - else #endif - { - allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size - + FBLK_FTR_SZ - + ABLK_HDR_SZ) - - ABLK_HDR_SZ); - allctr->sbc_header_size = (UNIT_CEILING(sizeof(Carrier_t) - + FBLK_FTR_SZ - + ABLK_HDR_SZ) - - ABLK_HDR_SZ); - } if (allctr->main_carrier_size) { Block_t *blk; -#if HALFWORD_HEAP - blk = create_carrier(allctr, - allctr->main_carrier_size, - CFLG_MBC - | CFLG_FORCE_SIZE - | CFLG_FORCE_MSEG - | CFLG_MAIN_CARRIER); -#else blk = create_carrier(allctr, allctr->main_carrier_size, CFLG_MBC | CFLG_FORCE_SIZE +#if !HALFWORD_HEAP && !HAVE_SUPER_ALIGNED_MB_CARRIERS | CFLG_FORCE_SYS_ALLOC - | CFLG_MAIN_CARRIER); #endif + | CFLG_MAIN_CARRIER); if (!blk) goto error; @@ -4303,9 +4349,9 @@ erts_alcu_stop(Allctr_t *allctr) while (allctr->sbc_list.first) destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first)); while (allctr->mbc_list.first) - destroy_carrier(allctr, MBC2FBLK(allctr, allctr->mbc_list.first)); + destroy_carrier(allctr, MBC_TO_FIRST_BLK(allctr, allctr->mbc_list.first)); while (allctr->sbmbc_list.first) - destroy_sbmbc(allctr, MBC2FBLK(allctr, allctr->sbmbc_list.first)); + destroy_sbmbc(allctr, MBC_TO_FIRST_BLK(allctr, allctr->sbmbc_list.first)); #ifdef USE_THREADS if (allctr->thread_safe) @@ -4319,17 +4365,9 @@ erts_alcu_stop(Allctr_t *allctr) void erts_alcu_init(AlcUInit_t *init) { - + ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */ #if HAVE_ERTS_MSEG - mseg_unit_size = erts_mseg_unit_size(); - - if (mseg_unit_size % sizeof(Unit_t)) /* A little paranoid... */ - erl_exit(-1, - "Mseg unit size (%d) not evenly divideble by " - "internal unit size of alloc_util (%d)\n", - mseg_unit_size, - sizeof(Unit_t)); - + ASSERT(erts_mseg_unit_size() == MSEG_UNIT_SZ); max_mseg_carriers = init->mmc; sys_alloc_carrier_size = MSEG_UNIT_CEILING(init->ycs); #else /* #if HAVE_ERTS_MSEG */ @@ -4372,11 +4410,10 @@ erts_alcu_test(unsigned long op, unsigned long a1, unsigned long a2) case 0x00b: return (unsigned long) CARRIER_SZ((Carrier_t *) a1); case 0x00c: return (unsigned long) SBC2BLK((Allctr_t *) a1, (Carrier_t *) a2); - case 0x00d: return (unsigned long) BLK2SBC((Allctr_t *) a1, - (Block_t *) a2); - case 0x00e: return (unsigned long) MBC2FBLK((Allctr_t *) a1, + case 0x00d: return (unsigned long) BLK_TO_SBC((Block_t *) a2); + case 0x00e: return (unsigned long) MBC_TO_FIRST_BLK((Allctr_t *) a1, (Carrier_t *) a2); - case 0x00f: return (unsigned long) FBLK2MBC((Allctr_t *) a1, + case 0x00f: return (unsigned long) FIRST_BLK_TO_MBC((Allctr_t *) a1, (Block_t *) a2); case 0x010: return (unsigned long) ((Allctr_t *) a1)->mbc_list.first; case 0x011: return (unsigned long) ((Allctr_t *) a1)->mbc_list.last; @@ -4388,7 +4425,7 @@ erts_alcu_test(unsigned long op, unsigned long a1, unsigned long a2) case 0x017: return (unsigned long) ((Allctr_t *) a1)->min_block_size; case 0x018: return (unsigned long) NXT_BLK((Block_t *) a1); case 0x019: return (unsigned long) PREV_BLK((Block_t *) a1); - case 0x01a: return (unsigned long) IS_FIRST_BLK((Block_t *) a1); + case 0x01a: return (unsigned long) IS_MBC_FIRST_BLK((Allctr_t*)a1, (Block_t *) a2); case 0x01b: return (unsigned long) sizeof(Unit_t); default: ASSERT(0); return ~((unsigned long) 0); } @@ -4432,6 +4469,13 @@ erts_alcu_verify_unused_ts(Allctr_t *allctr) #endif } +#ifdef DEBUG +int is_sbc_blk(Block_t* blk) +{ + return IS_SBC_BLK(blk); +} +#endif + #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG static void @@ -4441,34 +4485,37 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) CarrierList_t *cl; if (IS_SBC_BLK(iblk)) { - Carrier_t *sbc = BLK2SBC(allctr, iblk); + Carrier_t *sbc = BLK_TO_SBC(iblk); ASSERT(SBC2BLK(allctr, sbc) == iblk); - ASSERT(IS_ALLOCED_BLK(iblk)); - ASSERT(IS_FIRST_BLK(iblk)); - ASSERT(IS_LAST_BLK(iblk)); - ASSERT(CARRIER_SZ(sbc) - allctr->sbc_header_size >= BLK_SZ(iblk)); + ASSERT(CARRIER_SZ(sbc) - SBC_HEADER_SIZE >= SBC_BLK_SZ(iblk)); #if HAVE_ERTS_MSEG if (IS_MSEG_CARRIER(sbc)) { - ASSERT(CARRIER_SZ(sbc) % mseg_unit_size == 0); + ASSERT(CARRIER_SZ(sbc) % MSEG_UNIT_SZ == 0); } #endif crr = sbc; cl = &allctr->sbc_list; } else { - Carrier_t *mbc = NULL; Block_t *prev_blk = NULL; Block_t *blk; char *carrier_end; Uint is_free_blk; Uint tot_blk_sz; Uint blk_sz; + int has_wrapped_around = 0; blk = iblk; tot_blk_sz = 0; + crr = BLK_TO_MBC(blk); + ASSERT(IS_MB_CARRIER(crr)); + /* Step around the carrier one whole lap starting at 'iblk' + */ while (1) { + ASSERT(IS_MBC_BLK(blk)); + ASSERT(BLK_TO_MBC(blk) == crr); if (prev_blk) { ASSERT(NXT_BLK(prev_blk) == blk); @@ -4481,18 +4528,16 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) } } - if (mbc) { + if (has_wrapped_around) { + ASSERT(((Block_t *) crr) < blk); if (blk == iblk) break; - ASSERT(((Block_t *) mbc) < blk && blk < iblk); + ASSERT(blk < iblk); } else ASSERT(blk >= iblk); - - ASSERT(IS_MBC_BLK(blk)); - - blk_sz = BLK_SZ(blk); + blk_sz = MBC_BLK_SZ(blk); ASSERT(blk_sz % sizeof(Unit_t) == 0); ASSERT(blk_sz >= allctr->min_block_size); @@ -4500,44 +4545,40 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) tot_blk_sz += blk_sz; is_free_blk = (int) IS_FREE_BLK(blk); - if(is_free_blk) { - if (IS_NOT_LAST_BLK(blk)) - ASSERT(*((UWord *) (((char *) blk)+blk_sz-sizeof(UWord))) - == blk_sz); - } + ASSERT(!is_free_blk + || IS_LAST_BLK(blk) + || PREV_BLK_SZ(((char *) blk)+blk_sz) == blk_sz); if (allctr->check_block) (*allctr->check_block)(allctr, blk, (int) is_free_blk); if (IS_LAST_BLK(blk)) { carrier_end = ((char *) NXT_BLK(blk)); - mbc = *((Carrier_t **) NXT_BLK(blk)); + has_wrapped_around = 1; prev_blk = NULL; - blk = MBC2FBLK(allctr, mbc); - ASSERT(IS_FIRST_BLK(blk)); + blk = MBC_TO_FIRST_BLK(allctr, crr); + ASSERT(IS_MBC_FIRST_BLK(allctr,blk)); } else { prev_blk = blk; blk = NXT_BLK(blk); } } - - ASSERT(IS_MB_CARRIER(mbc)); - ASSERT((((char *) mbc) - + allctr->mbc_header_size + + ASSERT((((char *) crr) + + MBC_HEADER_SIZE(allctr) + tot_blk_sz) == carrier_end); - ASSERT(((char *) mbc) + CARRIER_SZ(mbc) - sizeof(Unit_t) <= carrier_end - && carrier_end <= ((char *) mbc) + CARRIER_SZ(mbc)); + ASSERT(((char *) crr) + CARRIER_SZ(crr) - sizeof(Unit_t) <= carrier_end + && carrier_end <= ((char *) crr) + CARRIER_SZ(crr)); if (allctr->check_mbc) - (*allctr->check_mbc)(allctr, mbc); + (*allctr->check_mbc)(allctr, crr); #if HAVE_ERTS_MSEG - if (IS_MSEG_CARRIER(mbc)) { - ASSERT(CARRIER_SZ(mbc) % mseg_unit_size == 0); + if (IS_MSEG_CARRIER(crr)) { + ASSERT(CARRIER_SZ(crr) % MSEG_UNIT_SZ == 0); } #endif - crr = mbc; cl = &allctr->mbc_list; } @@ -4559,4 +4600,5 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) #endif } -#endif +#endif /* ERTS_ALLOC_UTIL_HARD_DEBUG */ + diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index cedf4ccf85..e0754e7f69 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -216,16 +216,40 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #define UNIT_FLOOR(X) ((X) & UNIT_MASK) #define UNIT_CEILING(X) UNIT_FLOOR((X) + INV_UNIT_MASK) +#define FLG_MASK INV_UNIT_MASK +#define SBC_BLK_SZ_MASK UNIT_MASK +#define MBC_FBLK_SZ_MASK UNIT_MASK +#define CARRIER_SZ_MASK UNIT_MASK -#define SZ_MASK (~((UWord) 0) << 3) -#define FLG_MASK (~(SZ_MASK)) +#if HAVE_ERTS_MSEG +# ifdef ARCH_64 +# define MBC_ABLK_OFFSET_BITS 24 +# elif HAVE_SUPER_ALIGNED_MB_CARRIERS +# define MBC_ABLK_OFFSET_BITS 9 + /* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */ +# endif +#endif +#ifndef MBC_ABLK_OFFSET_BITS +# define MBC_ABLK_OFFSET_BITS 0 /* no carrier offset in block header */ +#endif + +#if MBC_ABLK_OFFSET_BITS +# define MBC_ABLK_OFFSET_SHIFT (sizeof(UWord)*8 - MBC_ABLK_OFFSET_BITS) +# define MBC_ABLK_OFFSET_MASK (~((UWord)0) << MBC_ABLK_OFFSET_SHIFT) +# define MBC_ABLK_SZ_MASK (~MBC_ABLK_OFFSET_MASK & ~FLG_MASK) +# define HAVE_ERTS_SBMBC 0 +#else +# define MBC_ABLK_SZ_MASK (~FLG_MASK) +# define HAVE_ERTS_SBMBC 1 +#endif -#define BLK_SZ(B) \ - (*((Block_t *) (B)) & SZ_MASK) +#define MBC_ABLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK) +#define MBC_FBLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_FBLK_SZ_MASK) +#define SBC_BLK_SZ(B) (ASSERT_EXPR(is_sbc_blk(B)), (B)->bhdr & SBC_BLK_SZ_MASK) #define CARRIER_SZ(C) \ - ((C)->chdr & SZ_MASK) + ((C)->chdr & CARRIER_SZ_MASK) extern int erts_have_sbmbc_alloc; @@ -236,6 +260,7 @@ struct Carrier_t_ { UWord chdr; Carrier_t *next; Carrier_t *prev; + Allctr_t *allctr; }; typedef struct { @@ -243,8 +268,19 @@ typedef struct { Carrier_t *last; } CarrierList_t; -typedef UWord Block_t; -typedef UWord FreeBlkFtr_t; +typedef struct { + UWord bhdr; +#if !MBC_ABLK_OFFSET_BITS + Carrier_t *carrier; +#else + union { + Carrier_t *carrier; /* if free */ + char udata__[1]; /* if allocated */ + }u; +#endif +} Block_t; + +typedef UWord FreeBlkFtr_t; /* Footer of a free block */ typedef struct { UWord giga_no; @@ -381,8 +417,6 @@ struct Allctr_t_ { #endif /* */ - Uint mbc_header_size; - Uint sbc_header_size; Uint min_mbc_size; Uint min_mbc_first_free_size; Uint min_block_size; @@ -469,6 +503,9 @@ void erts_alcu_verify_unused_ts(Allctr_t *allctr); unsigned long erts_alcu_test(unsigned long, unsigned long, unsigned long); +#ifdef DEBUG +int is_sbc_blk(Block_t*); +#endif #endif /* #if defined(GET_ERL_ALLOC_UTIL_IMPL) diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index 5bdb752d3a..86b4696d8f 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -91,6 +91,7 @@ struct AOFF_RBTree_t_ { AOFF_RBTree_t *right; Uint max_sz; /* of all blocks in this sub-tree */ }; +#define AOFF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr) #ifdef HARD_DEBUG static AOFF_RBTree_t * check_tree(AOFF_RBTree_t* root, Uint); @@ -102,7 +103,7 @@ static AOFF_RBTree_t * check_tree(AOFF_RBTree_t* root, Uint); */ static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x) { - Uint sz = BLK_SZ(x); + Uint sz = AOFF_BLK_SZ(x); if (x->left && x->left->max_sz > sz) { sz = x->left->max_sz; } @@ -183,7 +184,6 @@ erts_aoffalc_start(AOFFAllctr_t *alc, sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t)); - allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = sizeof(AOFF_RBTree_t); @@ -587,7 +587,7 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) AOFF_RBTree_t *blk = (AOFF_RBTree_t *) block; AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) ? &alc->sbmbc_root : &alc->mbc_root); - Uint blk_sz = BLK_SZ(blk); + Uint blk_sz = AOFF_BLK_SZ(blk); #ifdef HARD_DEBUG check_tree(*root, 0); @@ -659,7 +659,7 @@ aoff_get_free_block(Allctr_t *allctr, Uint size, if (x->left && x->left->max_sz >= size) { x = x->left; } - else if (BLK_SZ(x) >= size) { + else if (AOFF_BLK_SZ(x) >= size) { blk = x; break; } @@ -910,12 +910,12 @@ check_tree(AOFF_RBTree_t* root, Uint size) ASSERT(x->right > x); ASSERT(x->right->max_sz <= x->max_sz); } - ASSERT(x->max_sz >= BLK_SZ(x)); - ASSERT(x->max_sz == BLK_SZ(x) + ASSERT(x->max_sz >= AOFF_BLK_SZ(x)); + ASSERT(x->max_sz == AOFF_BLK_SZ(x) || x->max_sz == (x->left ? x->left->max_sz : 0) || x->max_sz == (x->right ? x->right->max_sz : 0)); - if (size && BLK_SZ(x) >= size) { + if (size && AOFF_BLK_SZ(x) >= size) { if (!res || x < res) { res = x; } @@ -956,7 +956,7 @@ print_tree_aux(AOFF_RBTree_t *x, int indent) } fprintf(stderr, "%s: sz=%lu addr=0x%lx max_size=%lu\r\n", IS_BLACK(x) ? "BLACK" : "RED", - BLK_SZ(x), (Uint)x, x->max_sz); + AOFF_BLK_SZ(x), (Uint)x, x->max_sz); print_tree_aux(x->left, indent + INDENT_STEP); } } diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index c50fdeb4e8..743cbd93c9 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.c +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -73,6 +73,8 @@ #define SET_RED(N) (((RBTree_t *) (N))->flags |= RED_FLG) #define SET_BLACK(N) (((RBTree_t *) (N))->flags &= ~RED_FLG) +#define BF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr) + #undef ASSERT #define ASSERT ASSERT_EXPR @@ -177,7 +179,6 @@ erts_bfalc_start(BFAllctr_t *bfallctr, bfallctr->address_order = bfinit->ao; - allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = (bfinit->ao @@ -592,7 +593,7 @@ aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) ? &bfallctr->sbmbc_root : &bfallctr->mbc_root); RBTree_t *blk = (RBTree_t *) block; - Uint blk_sz = BLK_SZ(blk); + Uint blk_sz = BF_BLK_SZ(blk); @@ -610,7 +611,7 @@ aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) while (1) { Uint size; - size = BLK_SZ(x); + size = BF_BLK_SZ(x); if (blk_sz < size || (blk_sz == size && blk < x)) { if (!x->left) { @@ -668,7 +669,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, ASSERT(!cand_blk || cand_size >= size); while (x) { - blk_sz = BLK_SZ(x); + blk_sz = BF_BLK_SZ(x); if (blk_sz < size) { x = x->right; } @@ -686,7 +687,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, #endif if (cand_blk) { - blk_sz = BLK_SZ(blk); + blk_sz = BF_BLK_SZ(blk); if (cand_size < blk_sz) return NULL; /* cand_blk was better */ if (cand_size == blk_sz && ((void *) cand_blk) < ((void *) blk)) @@ -711,7 +712,7 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) ? &bfallctr->sbmbc_root : &bfallctr->mbc_root); RBTree_t *blk = (RBTree_t *) block; - Uint blk_sz = BLK_SZ(blk); + Uint blk_sz = BF_BLK_SZ(blk); SET_TREE_NODE(blk); @@ -730,7 +731,7 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) while (1) { Uint size; - size = BLK_SZ(x); + size = BF_BLK_SZ(x); if (blk_sz == size) { @@ -796,7 +797,7 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) else if (LIST_NEXT(x)) { /* Replace tree node by next element in list... */ - ASSERT(BLK_SZ(LIST_NEXT(x)) == BLK_SZ(x)); + ASSERT(BF_BLK_SZ(LIST_NEXT(x)) == BF_BLK_SZ(x)); ASSERT(IS_TREE_NODE(x)); ASSERT(IS_LIST_ELEM(LIST_NEXT(x))); @@ -834,7 +835,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size, ASSERT(!cand_blk || cand_size >= size); while (x) { - blk_sz = BLK_SZ(x); + blk_sz = BF_BLK_SZ(x); if (blk_sz < size) { x = x->right; } @@ -855,11 +856,11 @@ bf_get_free_block(Allctr_t *allctr, Uint size, #ifdef HARD_DEBUG { RBTree_t *ct_blk = check_tree(root, 0, size); - ASSERT(BLK_SZ(ct_blk) == BLK_SZ(blk)); + ASSERT(BF_BLK_SZ(ct_blk) == BF_BLK_SZ(blk)); } #endif - if (cand_blk && cand_size <= BLK_SZ(blk)) + if (cand_blk && cand_size <= BF_BLK_SZ(blk)) return NULL; /* cand_blk was better */ /* Use next block if it exist in order to avoid replacing @@ -1093,36 +1094,36 @@ check_tree(RBTree_t *root, int ao, Uint size) if (x->left) { ASSERT(x->left->parent == x); if (ao) { - ASSERT(BLK_SZ(x->left) < BLK_SZ(x) - || (BLK_SZ(x->left) == BLK_SZ(x) && x->left < x)); + ASSERT(BF_BLK_SZ(x->left) < BF_BLK_SZ(x) + || (BF_BLK_SZ(x->left) == BF_BLK_SZ(x) && x->left < x)); } else { ASSERT(IS_TREE_NODE(x->left)); - ASSERT(BLK_SZ(x->left) < BLK_SZ(x)); + ASSERT(BF_BLK_SZ(x->left) < BF_BLK_SZ(x)); } } if (x->right) { ASSERT(x->right->parent == x); if (ao) { - ASSERT(BLK_SZ(x->right) > BLK_SZ(x) - || (BLK_SZ(x->right) == BLK_SZ(x) && x->right > x)); + ASSERT(BF_BLK_SZ(x->right) > BF_BLK_SZ(x) + || (BF_BLK_SZ(x->right) == BF_BLK_SZ(x) && x->right > x)); } else { ASSERT(IS_TREE_NODE(x->right)); - ASSERT(BLK_SZ(x->right) > BLK_SZ(x)); + ASSERT(BF_BLK_SZ(x->right) > BF_BLK_SZ(x)); } } - if (size && BLK_SZ(x) >= size) { + if (size && BF_BLK_SZ(x) >= size) { if (ao) { if (!res - || BLK_SZ(x) < BLK_SZ(res) - || (BLK_SZ(x) == BLK_SZ(res) && x < res)) + || BF_BLK_SZ(x) < BF_BLK_SZ(res) + || (BF_BLK_SZ(x) == BF_BLK_SZ(res) && x < res)) res = x; } else { - if (!res || BLK_SZ(x) < BLK_SZ(res)) + if (!res || BF_BLK_SZ(x) < BF_BLK_SZ(res)) res = x; } } @@ -1168,7 +1169,7 @@ print_tree_aux(RBTree_t *x, int indent) } fprintf(stderr, "%s: sz=%lu addr=0x%lx\r\n", IS_BLACK(x) ? "BLACK" : "RED", - BLK_SZ(x), + BF_BLK_SZ(x), (Uint) x); print_tree_aux(x->left, indent + INDENT_STEP); } diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 3f90f34736..93ef09a677 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -620,30 +620,38 @@ write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size) int erts_init_scheduler_bind_type_string(char *how) { + ErtsCpuBindOrder order; + if (sys_strcmp(how, "u") == 0) - cpu_bind_order = ERTS_CPU_BIND_NONE; - else if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) - return ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED; - else if (!system_cpudata && !user_cpudata) - return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY; + order = ERTS_CPU_BIND_NONE; else if (sys_strcmp(how, "db") == 0) - cpu_bind_order = ERTS_CPU_BIND_DEFAULT_BIND; + order = ERTS_CPU_BIND_DEFAULT_BIND; else if (sys_strcmp(how, "s") == 0) - cpu_bind_order = ERTS_CPU_BIND_SPREAD; + order = ERTS_CPU_BIND_SPREAD; else if (sys_strcmp(how, "ps") == 0) - cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD; + order = ERTS_CPU_BIND_PROCESSOR_SPREAD; else if (sys_strcmp(how, "ts") == 0) - cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD; + order = ERTS_CPU_BIND_THREAD_SPREAD; else if (sys_strcmp(how, "tnnps") == 0) - cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD; + order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD; else if (sys_strcmp(how, "nnps") == 0) - cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD; + order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD; else if (sys_strcmp(how, "nnts") == 0) - cpu_bind_order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; + order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; else if (sys_strcmp(how, "ns") == 0) - cpu_bind_order = ERTS_CPU_BIND_NO_SPREAD; + order = ERTS_CPU_BIND_NO_SPREAD; else - return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE; + return ERTS_INIT_SCHED_BIND_TYPE_ERROR_BAD_TYPE; + + if (order != ERTS_CPU_BIND_NONE) { + if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) + return ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED; + else if (!system_cpudata && !user_cpudata) + return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY; + } + + cpu_bind_order = order; + return ERTS_INIT_SCHED_BIND_TYPE_SUCCESS; } diff --git a/erts/emulator/beam/erl_cpu_topology.h b/erts/emulator/beam/erl_cpu_topology.h index c5a9520b61..11915e1ea8 100644 --- a/erts/emulator/beam/erl_cpu_topology.h +++ b/erts/emulator/beam/erl_cpu_topology.h @@ -40,7 +40,7 @@ void erts_init_cpu_topology(void); #define ERTS_INIT_SCHED_BIND_TYPE_SUCCESS 0 #define ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED 1 #define ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY 2 -#define ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE 3 +#define ERTS_INIT_SCHED_BIND_TYPE_ERROR_BAD_TYPE 3 int erts_init_scheduler_bind_type_string(char *how); diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index bcdb630140..bb08762b26 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -5009,7 +5009,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) static Eterm seq_trace_fake(Process *p, Eterm arg1) { Eterm result = erl_seq_trace_info(p, arg1); - if (is_tuple(result) && *tuple_val(result) == 2) { + if (!is_non_value(result) && is_tuple(result) && *tuple_val(result) == 2) { return (tuple_val(result))[2]; } return result; diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 046b46513f..d50ba364d0 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -85,7 +85,7 @@ #include "erl_drv_nif.h" #include <stdlib.h> -#include <string.h> /* ssize_t on Mac OS X */ +#include <sys/types.h> /* ssize_t */ #if defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_) #ifndef STATIC_ERLANG_DRIVER diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index d377ba8f31..a33085315a 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -129,7 +129,7 @@ static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int n #if defined(ARCH_64) && !HALFWORD_HEAP # define MAX_HEAP_SIZES 154 #else -# define MAX_HEAP_SIZES 55 +# define MAX_HEAP_SIZES 59 #endif static Sint heap_sizes[MAX_HEAP_SIZES]; /* Suitable heap sizes. */ @@ -144,6 +144,7 @@ void erts_init_gc(void) { int i = 0; + Sint max_heap_size = 0; ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word)); ASSERT(offsetof(ProcBin,thing_word) == offsetof(ErlFunThing,thing_word)); @@ -168,16 +169,30 @@ erts_init_gc(void) * we really don't want that growth when the heaps are that big. */ - heap_sizes[0] = 34; - heap_sizes[1] = 55; - for (i = 2; i < 23; i++) { - heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-2]; + /* Growth stage 1 - Fibonacci + 1*/ + /* 12,38 will hit size 233, the old default */ + + heap_sizes[0] = 12; + heap_sizes[1] = 38; + + for(i = 2; i < 23; i++) { + /* one extra word for block header */ + heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-2] + 1; } + + /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] (and halfword) + * for 64 bit we want max_heap_size to be MAX(52bit) / 8 [words] + */ + + max_heap_size = sizeof(Eterm) < 8 ? (Sint)((~(Uint)0)/(sizeof(Eterm))) : + (Sint)(((Uint64)1 << 53)/sizeof(Eterm)); + + /* Growth stage 2 - 20% growth */ /* At 1.3 mega words heap, we start to slow down. */ for (i = 23; i < ALENGTH(heap_sizes); i++) { - heap_sizes[i] = 5*(heap_sizes[i-1]/4); - if (heap_sizes[i] < 0) { + heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-1]/5; + if ((heap_sizes[i] < 0) || heap_sizes[i] > max_heap_size) { /* Size turned negative. Discard this last size. */ i--; break; @@ -868,14 +883,12 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) } } - if (wanted < MIN_HEAP_SIZE(p)) { - wanted = MIN_HEAP_SIZE(p); - } else { - wanted = next_heap_size(p, wanted, 0); - } + wanted = wanted < MIN_HEAP_SIZE(p) ? MIN_HEAP_SIZE(p) + : next_heap_size(p, wanted, 0); if (wanted < HEAP_SIZE(p)) { shrink_new_heap(p, wanted, objv, nobj); } + ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); return 1; /* We are done. */ } @@ -1434,11 +1447,10 @@ adjust_after_fullsweep(Process *p, Uint size_before, int need, Eterm *objv, int I think this is better as fullsweep is used mainly on small memory systems, but I could be wrong... */ wanted = 2 * need_after; - if (wanted < p->min_heap_size) { - sz = p->min_heap_size; - } else { - sz = next_heap_size(p, wanted, 0); - } + + sz = wanted < p->min_heap_size ? p->min_heap_size + : next_heap_size(p, wanted, 0); + if (sz < HEAP_SIZE(p)) { shrink_new_heap(p, sz, objv, nobj); } diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c index e7d4ac2b67..f98d377fd6 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.c +++ b/erts/emulator/beam/erl_goodfit_alloc.c @@ -205,7 +205,6 @@ erts_gfalc_start(GFAllctr_t *gfallctr, init->sbmbct = 0; /* Small mbc not yet supported by goodfit */ - allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = sizeof(GFFreeBlock_t); @@ -363,7 +362,7 @@ search_bucket(Allctr_t *allctr, int ix, Uint size) blk && i < max_blk_search; blk = blk->next, i++) { - blk_sz = BLK_SZ(blk); + blk_sz = MBC_FBLK_SZ(&blk->block_head); blk_on_lambc = (((char *) blk) < gfallctr->last_aux_mbc_end && gfallctr->last_aux_mbc_start <= ((char *) blk)); @@ -402,7 +401,7 @@ get_free_block(Allctr_t *allctr, Uint size, if (min_bi == unsafe_bi) { blk = search_bucket(allctr, min_bi, size); if (blk) { - if (cand_blk && cand_size <= BLK_SZ(blk)) + if (cand_blk && cand_size <= MBC_FBLK_SZ(blk)) return NULL; /* cand_blk was better */ unlink_free_block(allctr, blk, flags); return blk; @@ -422,7 +421,7 @@ get_free_block(Allctr_t *allctr, Uint size, /* We are guaranteed to find a block that fits in this bucket */ blk = search_bucket(allctr, min_bi, size); ASSERT(blk); - if (cand_blk && cand_size <= BLK_SZ(blk)) + if (cand_blk && cand_size <= MBC_FBLK_SZ(blk)) return NULL; /* cand_blk was better */ unlink_free_block(allctr, blk, flags); return blk; @@ -435,7 +434,7 @@ link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; GFFreeBlock_t *blk = (GFFreeBlock_t *) block; - Uint sz = BLK_SZ(blk); + Uint sz = MBC_FBLK_SZ(&blk->block_head); int i = BKT_IX(gfallctr, sz); ASSERT(sz >= MIN_BLK_SZ); @@ -456,7 +455,7 @@ unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; GFFreeBlock_t *blk = (GFFreeBlock_t *) block; - Uint sz = BLK_SZ(blk); + Uint sz = MBC_FBLK_SZ(&blk->block_head); int i = BKT_IX(gfallctr, sz); if (!blk->prev) { @@ -618,7 +617,7 @@ check_block(Allctr_t *allctr, Block_t * blk, int free_block) GFFreeBlock_t *fblk; if(free_block) { - Uint blk_sz = BLK_SZ(blk); + Uint blk_sz = is_sbc_blk(blk) ? SBC_BLK_SZ(blk) : MBC_BLK_SZ(blk); bi = BKT_IX(gfallctr, blk_sz); ASSERT(gfallctr->bucket_mask.main & (((UWord) 1) << IX2SMIX(bi))); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 175f04b15b..516f7b3cb3 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -55,6 +55,8 @@ # include <sys/resource.h> #endif +#define ERTS_DEFAULT_NO_ASYNC_THREADS 10 + /* * The variables below (prefixed with etp_) are for erts/etc/unix/etp-commands * only. Do not remove even though they aren't used elsewhere in the emulator! @@ -521,7 +523,7 @@ void erts_usage(void) erts_fprintf(stderr, "-r force ets memory block to be moved on realloc\n"); erts_fprintf(stderr, "-rg amount set reader groups limit\n"); erts_fprintf(stderr, "-sbt type set scheduler bind type, valid types are:\n"); - erts_fprintf(stderr, " u|ns|ts|ps|s|nnts|nnps|tnnps|db\n"); + erts_fprintf(stderr, "-stbt type u|ns|ts|ps|s|nnts|nnps|tnnps|db\n"); erts_fprintf(stderr, "-sbwt val set scheduler busy wait threshold, valid values are:\n"); erts_fprintf(stderr, " none|very_short|short|medium|long|very_long.\n"); erts_fprintf(stderr, "-scl bool enable/disable compaction of scheduler load,\n"); @@ -529,7 +531,7 @@ void erts_usage(void) erts_fprintf(stderr, "-sct cput set cpu topology,\n"); erts_fprintf(stderr, " see the erl(1) documentation for more info.\n"); erts_fprintf(stderr, "-sws val set scheduler wakeup strategy, valid values are:\n"); - erts_fprintf(stderr, " default|legacy|proposal.\n"); + erts_fprintf(stderr, " default|legacy.\n"); erts_fprintf(stderr, "-swt val set scheduler wakeup threshold, valid values are:\n"); erts_fprintf(stderr, " very_low|low|medium|high|very_high.\n"); erts_fprintf(stderr, "-sss size suggested stack size in kilo words for scheduler threads,\n"); @@ -631,7 +633,7 @@ early_init(int *argc, char **argv) /* erts_disable_tolerant_timeofday = 0; display_items = 200; erts_backtrace_depth = DEFAULT_BACKTRACE_SIZE; - erts_async_max_threads = 0; + erts_async_max_threads = ERTS_DEFAULT_NO_ASYNC_THREADS; erts_async_thread_suggested_stack_size = ERTS_ASYNC_THREAD_MIN_STACK_SIZE; H_MIN_SIZE = H_DEFAULT_SIZE; BIN_VH_MIN_SIZE = VH_DEFAULT_SIZE; @@ -700,7 +702,7 @@ early_init(int *argc, char **argv) /* if (erts_sys_getenv__("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0) erts_async_max_threads = atoi(envbuf); else - erts_async_max_threads = 0; + erts_async_max_threads = ERTS_DEFAULT_NO_ASYNC_THREADS; if (erts_async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS) erts_async_max_threads = ERTS_MAX_NO_OF_ASYNC_THREADS; @@ -989,6 +991,7 @@ erl_start(int argc, char **argv) break; case 'a': erts_set_user_requested_filename_encoding(ERL_FILENAME_UNKNOWN); + break; default: erts_fprintf(stderr, "bad filename encoding %s, can be (l,u or a)\n", arg); erts_usage(); @@ -1237,7 +1240,7 @@ erl_start(int argc, char **argv) case ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY: estr = "no cpu topology available"; break; - case ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE: + case ERTS_INIT_SCHED_BIND_TYPE_ERROR_BAD_TYPE: estr = "invalid type"; break; default: @@ -1332,6 +1335,16 @@ erl_start(int argc, char **argv) } else if (sys_strcmp("nsp", sub_param) == 0) erts_use_sender_punish = 0; + else if (has_prefix("tbt", sub_param)) { + arg = get_arg(sub_param+3, argv[i+1], &i); + res = erts_init_scheduler_bind_type_string(arg); + if (res == ERTS_INIT_SCHED_BIND_TYPE_ERROR_BAD_TYPE) { + erts_fprintf(stderr, + "setting scheduler bind type '%s' failed: invalid type\n", + arg); + erts_usage(); + } + } else if (sys_strcmp("wt", sub_param) == 0) { arg = get_arg(sub_param+2, argv[i+1], &i); if (erts_sched_set_wakeup_other_thresold(arg) != 0) { diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index aaca4b5f59..6e9bf7ca12 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -4080,11 +4080,11 @@ typedef enum { } ErtsSchedWakeupOtherThreshold; typedef enum { - ERTS_SCHED_WAKEUP_OTHER_TYPE_PROPOSAL, + ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT, ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY } ErtsSchedWakeupOtherType; -/* First proposal */ +/* Default */ #define ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH (200*CONTEXT_REDS) #define ERTS_WAKEUP_OTHER_LIMIT_HIGH (50*CONTEXT_REDS) @@ -4101,7 +4101,7 @@ typedef enum { #define ERTS_WAKEUP_OTHER_DEC_SHIFT 2 #define ERTS_WAKEUP_OTHER_FIXED_INC (CONTEXT_REDS/10) -/* To be legacy */ +/* Legacy */ #define ERTS_WAKEUP_OTHER_LIMIT_VERY_HIGH_LEGACY (200*CONTEXT_REDS) #define ERTS_WAKEUP_OTHER_LIMIT_HIGH_LEGACY (50*CONTEXT_REDS) @@ -4239,7 +4239,7 @@ static void set_wakeup_other_data(void) { switch (wakeup_other.type) { - case ERTS_SCHED_WAKEUP_OTHER_TYPE_PROPOSAL: + case ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT: wakeup_other.check = wakeup_other_check; wakeup_other_set_limit(); break; @@ -4258,7 +4258,7 @@ erts_early_init_scheduling(int no_schedulers) aux_work_timeout_early_init(no_schedulers); #ifdef ERTS_SMP wakeup_other.threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM; - wakeup_other.type = ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY; + wakeup_other.type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT; #endif sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM; sched_busy_wait.tse = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM @@ -4294,10 +4294,8 @@ int erts_sched_set_wakeup_other_type(char *str) { ErtsSchedWakeupOtherType type; - if (sys_strcmp(str, "proposal") == 0) - type = ERTS_SCHED_WAKEUP_OTHER_TYPE_PROPOSAL; - else if (sys_strcmp(str, "default") == 0) - type = ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY; + if (sys_strcmp(str, "default") == 0) + type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT; else if (sys_strcmp(str, "legacy") == 0) type = ERTS_SCHED_WAKEUP_OTHER_TYPE_LEGACY; else diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index 6a04c6fc0b..4587cd84d1 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -133,7 +133,7 @@ ET_DEFINE_CHECKED(Uint,unsigned_val,Eterm,is_small); ET_DEFINE_CHECKED(Sint,signed_val,Eterm,is_small); ET_DEFINE_CHECKED(Uint,atom_val,Eterm,is_atom); ET_DEFINE_CHECKED(Uint,header_arity,Eterm,is_header); -ET_DEFINE_CHECKED(Uint,arityval,Eterm,is_arity_value); +ET_DEFINE_CHECKED(Uint,arityval,Eterm,is_sane_arity_value); ET_DEFINE_CHECKED(Uint,thing_arityval,Eterm,is_thing); ET_DEFINE_CHECKED(Uint,thing_subtag,Eterm,is_thing); ET_DEFINE_CHECKED(Eterm*,binary_val,Wterm,is_binary); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index bc4c3a09a0..fb3ef9cd6c 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -300,8 +300,17 @@ _ET_DECLARE_CHECKED(Uint,header_arity,Eterm) #define header_arity(x) _ET_APPLY(header_arity,(x)) /* arityval access methods */ +/* Erlang Spec. 4.7.3 defines max arity to 65535 + * we will however enforce max arity of 16777215 (24 bits) + * (checked in bifs and asserted in debug) + */ +#define MAX_ARITYVAL ((((Uint)1) << 24) - 1) +#define ERTS_MAX_TUPLE_SIZE MAX_ARITYVAL + #define make_arityval(sz) _make_header((sz),_TAG_HEADER_ARITYVAL) #define is_arity_value(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_ARITYVAL) +#define is_sane_arity_value(x) ((((x) & _TAG_HEADER_MASK) == _TAG_HEADER_ARITYVAL) && \ + (((x) >> _HEADER_ARITY_OFFS) <= MAX_ARITYVAL)) #define is_not_arity_value(x) (!is_arity_value((x))) #define _unchecked_arityval(x) _unchecked_header_arity((x)) _ET_DECLARE_CHECKED(Uint,arityval,Eterm) diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 41f33efa79..848877d43e 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -44,9 +44,9 @@ #undef DEBUG_PRINTOUTS #endif -extern Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ -extern Eterm beam_return_trace[1]; /* OpCode(i_return_trace) */ -extern Eterm beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ +extern BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ +extern BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */ +extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ /* Pseudo export entries. Never filled in with data, only used to yield unique pointers of the correct type. */ diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 912f5d3d8b..25b02db2c9 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -56,6 +56,7 @@ #define FILE_FDATASYNC 30 #define FILE_FADVISE 31 #define FILE_SENDFILE 32 +#define FILE_FALLOCATE 33 /* Return codes */ @@ -439,6 +440,7 @@ struct t_data Efile_error errInfo; int flags; SWord fd; + int is_fd_unused; /**/ Efile_info info; EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */ @@ -503,6 +505,10 @@ struct t_data Uint64 written; } sendfile; #endif /* HAVE_SENDFILE */ + struct { + Sint64 offset; + Sint64 length; + } fallocate; } c; char b[1]; }; @@ -781,11 +787,6 @@ file_start(ErlDrvPort port, char* command) return (ErlDrvData) desc; } -static void free_data(void *data) -{ - EF_FREE(data); -} - static void do_close(int flags, SWord fd) { if (flags & EFILE_COMPRESSED) { erts_gzclose((gzFile)(fd)); @@ -803,6 +804,17 @@ static void invoke_close(void *data) DTRACE_INVOKE_RETURN(FILE_CLOSE); } +static void free_data(void *data) +{ + struct t_data *d = (struct t_data *) data; + + if (d->command == FILE_OPEN && d->is_fd_unused && d->fd != FILE_FD_INVALID) { + do_close(d->flags, d->fd); + } + + EF_FREE(data); +} + /********************************************************************* * Driver entry point -> stop */ @@ -1862,6 +1874,9 @@ static void invoke_open(void *data) } d->result_ok = status; + if (!status) { + d->fd = FILE_FD_INVALID; + } DTRACE_INVOKE_RETURN(FILE_OPEN); } @@ -1953,6 +1968,17 @@ static int flush_sendfile(file_descriptor *desc,void *_) { #endif /* HAVE_SENDFILE */ +static void invoke_fallocate(void *data) +{ + struct t_data *d = (struct t_data *) data; + int fd = (int) d->fd; + Sint64 offset = d->c.fallocate.offset; + Sint64 length = d->c.fallocate.length; + + d->again = 0; + d->result_ok = efile_fallocate(&d->errInfo, fd, offset, length); +} + static void free_readdir(void *data) { struct t_data *d = (struct t_data *) data; @@ -2348,6 +2374,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) case FILE_RENAME: case FILE_WRITE_INFO: case FILE_FADVISE: + case FILE_FALLOCATE: reply(desc, d->result_ok, &d->errInfo); free_data(data); break; @@ -2373,8 +2400,10 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) if (!d->result_ok) { reply_error(desc, &d->errInfo); } else { + ASSERT(d->is_fd_unused); desc->fd = d->fd; desc->flags = d->flags; + d->is_fd_unused = 0; reply_Uint(desc, d->fd); } free_data(data); @@ -2745,6 +2774,7 @@ file_output(ErlDrvData e, char* buf, ErlDrvSizeT count) d->invoke = invoke_open; d->free = free_data; d->level = 2; + d->is_fd_unused = 1; goto done; } @@ -2958,6 +2988,20 @@ file_output(ErlDrvData e, char* buf, ErlDrvSizeT count) goto done; } + case FILE_FALLOCATE: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data)); + + d->fd = fd; + d->command = command; + d->invoke = invoke_fallocate; + d->free = free_data; + d->level = 2; + d->c.fallocate.offset = get_int64((uchar*) buf); + d->c.fallocate.length = get_int64(((uchar*) buf) + sizeof(Sint64)); + goto done; + } + } /* diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index 69ad02633c..b29b4f971c 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -185,3 +185,4 @@ int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length, int efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd, off_t *offset, Uint64 *nbytes, struct t_sendfile_hdtl *hdtl); #endif /* HAVE_SENDFILE */ +int efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length); diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c index a109e40333..7f7cd7cd91 100644 --- a/erts/emulator/drivers/common/ram_file_drv.c +++ b/erts/emulator/drivers/common/ram_file_drv.c @@ -48,6 +48,7 @@ #define RAM_FILE_SIZE 37 /* get file size */ #define RAM_FILE_ADVISE 38 /* predeclare the access * pattern for file data */ +#define RAM_FILE_ALLOCATE 39 /* allocate space for a file */ /* possible new operations include: DES_ENCRYPT DES_DECRYPT @@ -720,6 +721,13 @@ static void rfile_command(ErlDrvData e, char* buf, ErlDrvSizeT count) else reply(f, 1, 0); break; + + case RAM_FILE_ALLOCATE: + if (f->flags == 0) + error_reply(f, EBADF); + else + reply(f, 1, 0); + break; } /* * Ignore anything else -- let the caller hang. diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index b29f80a8ba..ab2abb88d1 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -912,11 +912,15 @@ static int insert_buf(byte *s, int n) lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch)); ch = 0; } while (lpos % 8); - } else if (ch == '\n' || ch == '\r') { + } else if (ch == '\e' || ch == '\n' || ch == '\r') { write_buf(lbuf + buffpos, lpos - buffpos); - outc('\r'); - if (ch == '\n') - outc('\n'); + if (ch == '\e') { + outc('\e'); + } else { + outc('\r'); + if (ch == '\n') + outc('\n'); + } if (llen > lpos) { memcpy(lbuf, lbuf + lpos, llen - lpos); } diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index cf7af71b92..558651fff9 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -22,6 +22,12 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif +#if defined(HAVE_POSIX_FALLOCATE) && !defined(__sun) && !defined(__sun__) +#define _XOPEN_SOURCE 600 +#endif +#if !defined(_GNU_SOURCE) && defined(HAVE_LINUX_FALLOC_H) +#define _GNU_SOURCE +#endif #include "sys.h" #include "erl_driver.h" #include "erl_efile.h" @@ -41,9 +47,13 @@ #define DARWIN 1 #endif -#ifdef DARWIN +#if defined(DARWIN) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE) #include <fcntl.h> -#endif /* DARWIN */ +#endif + +#ifdef HAVE_LINUX_FALLOC_H +#include <linux/falloc.h> +#endif #ifdef SUNOS4 # define getcwd(buf, size) getwd(buf) @@ -967,3 +977,81 @@ efile_sendfile(Efile_error* errInfo, int in_fd, int out_fd, return check_error(retval, errInfo); } #endif /* HAVE_SENDFILE */ + +#ifdef HAVE_POSIX_FALLOCATE +static int +call_posix_fallocate(int fd, Sint64 offset, Sint64 length) +{ + int ret; + + /* + * On Linux and Solaris for example, posix_fallocate() returns + * a positive error number on error and it does not set errno. + * On FreeBSD however (9.0 at least), it returns -1 on error + * and it sets errno. + */ + do { + ret = posix_fallocate(fd, (off_t) offset, (off_t) length); + if (ret > 0) { + errno = ret; + ret = -1; + } + } while (ret != 0 && errno == EINTR); + + return ret; +} +#endif /* HAVE_POSIX_FALLOCATE */ + +int +efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length) +{ +#if defined HAVE_FALLOCATE + /* Linux specific, more efficient than posix_fallocate. */ + int ret; + + do { + ret = fallocate(fd, FALLOC_FL_KEEP_SIZE, (off_t) offset, (off_t) length); + } while (ret != 0 && errno == EINTR); + +#if defined HAVE_POSIX_FALLOCATE + /* Fallback to posix_fallocate if available. */ + if (ret != 0) { + ret = call_posix_fallocate(fd, offset, length); + } +#endif + + return check_error(ret, errInfo); +#elif defined F_PREALLOCATE + /* Mac OS X specific, equivalent to posix_fallocate. */ + int ret; + fstore_t fs; + + memset(&fs, 0, sizeof(fs)); + fs.fst_flags = F_ALLOCATECONTIG; + fs.fst_posmode = F_VOLPOSMODE; + fs.fst_offset = (off_t) offset; + fs.fst_length = (off_t) length; + + ret = fcntl(fd, F_PREALLOCATE, &fs); + + if (-1 == ret) { + fs.fst_flags = F_ALLOCATEALL; + ret = fcntl(fd, F_PREALLOCATE, &fs); + +#if defined HAVE_POSIX_FALLOCATE + /* Fallback to posix_fallocate if available. */ + if (-1 == ret) { + ret = call_posix_fallocate(fd, offset, length); + } +#endif + } + + return check_error(ret, errInfo); +#elif defined HAVE_POSIX_FALLOCATE + /* Other Unixes, use posix_fallocate if available. */ + return check_error(call_posix_fallocate(fd, offset, length), errInfo); +#else + errno = ENOTSUP; + return check_error(-1, errInfo); +#endif +} diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index dc7add01f7..f2b0c8a843 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -41,6 +41,8 @@ #define IS_DOT_OR_DOTDOT(s) \ ((s)[0] == L'.' && ((s)[1] == L'\0' || ((s)[1] == L'.' && (s)[2] == L'\0'))) +#define FILE_SHARE_FLAGS (FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE) + #ifndef INVALID_FILE_ATTRIBUTES #define INVALID_FILE_ATTRIBUTES ((DWORD) 0xFFFFFFFF) #endif @@ -724,7 +726,7 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ crFlags = CREATE_NEW; } fd = CreateFileW(wname, access, - FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, + FILE_SHARE_FLAGS, NULL, crFlags, FILE_ATTRIBUTE_NORMAL, NULL); /* @@ -909,7 +911,7 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, { HANDLE handle; /* Handle returned by CreateFile() */ BY_HANDLE_FILE_INFORMATION fileInfo; /* from CreateFile() */ - if (handle = CreateFileW(name, GENERIC_READ, 0,NULL, + if (handle = CreateFileW(name, GENERIC_READ, FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, 0, NULL)) { GetFileInformationByHandle(handle, &fileInfo); pInfo->links = fileInfo.nNumberOfLinks; @@ -1021,7 +1023,7 @@ efile_write_info(Efile_error* errInfo, } fd = CreateFileW(wname, GENERIC_READ|GENERIC_WRITE, - FILE_SHARE_READ | FILE_SHARE_WRITE, + FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (fd != INVALID_HANDLE_VALUE) { BOOL result = SetFileTime(fd, &CreationFileTime, &AccessFileTime, &ModifyFileTime); @@ -1384,7 +1386,7 @@ efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) DWORD fileAttributes = GetFileAttributesW(wname); if ((fileAttributes & FILE_ATTRIBUTE_REPARSE_POINT)) { BOOLEAN success = 0; - HANDLE h = CreateFileW(wname, GENERIC_READ, 0,NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + HANDLE h = CreateFileW(wname, GENERIC_READ, FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); int len; if(h != INVALID_HANDLE_VALUE) { success = pGetFinalPathNameByHandle(h, wbuffer, size / sizeof(WCHAR),0); @@ -1558,3 +1560,13 @@ efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, errno = ERROR_SUCCESS; return check_error(0, errInfo); } + +int +efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length) +{ + /* No file preallocation method available in Windows. */ + errno = errno_map(ERROR_NOT_SUPPORTED); + SetLastError(ERROR_NOT_SUPPORTED); + + return check_error(-1, errInfo); +} diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index 5911d76ad9..0e287908b1 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -262,47 +262,6 @@ static const struct literal { const char *name; int value; } literals[] = { - /* Field offsets in a process struct */ - { "P_HP", offsetof(struct process, htop) }, - { "P_HP_LIMIT", offsetof(struct process, stop) }, - { "P_OFF_HEAP_FIRST", offsetof(struct process, off_heap.first) }, - { "P_MBUF", offsetof(struct process, mbuf) }, - { "P_ID", offsetof(struct process, common.id) }, - { "P_FLAGS", offsetof(struct process, flags) }, - { "P_FVALUE", offsetof(struct process, fvalue) }, - { "P_FREASON", offsetof(struct process, freason) }, - { "P_FTRACE", offsetof(struct process, ftrace) }, - { "P_FCALLS", offsetof(struct process, fcalls) }, - { "P_BEAM_IP", offsetof(struct process, i) }, - { "P_ARITY", offsetof(struct process, arity) }, - { "P_ARG0", offsetof(struct process, def_arg_reg[0]) }, - { "P_ARG1", offsetof(struct process, def_arg_reg[1]) }, - { "P_ARG2", offsetof(struct process, def_arg_reg[2]) }, - { "P_ARG3", offsetof(struct process, def_arg_reg[3]) }, - { "P_ARG4", offsetof(struct process, def_arg_reg[4]) }, - { "P_ARG5", offsetof(struct process, def_arg_reg[5]) }, -#ifdef HIPE - { "P_NSP", offsetof(struct process, hipe.nsp) }, - { "P_NCALLEE", offsetof(struct process, hipe.ncallee) }, - { "P_CLOSURE", offsetof(struct process, hipe.closure) }, -#if defined(__i386__) || defined(__x86_64__) - { "P_NSP_LIMIT", offsetof(struct process, hipe.nstack) }, - { "P_CSP", offsetof(struct process, hipe.ncsp) }, -#elif defined(__sparc__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) - { "P_NSP_LIMIT", offsetof(struct process, hipe.nstack) }, - { "P_NRA", offsetof(struct process, hipe.nra) }, -#endif - { "P_NARITY", offsetof(struct process, hipe.narity) }, - { "P_FLOAT_RESULT", -# ifdef NO_FPE_SIGNALS - offsetof(struct process, hipe.float_result) -# endif - }, -# if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) - { "P_BIF_CALLEE", offsetof(struct process, hipe.bif_callee) }, -# endif -#endif /* HIPE */ - /* process flags bits */ { "F_TIMO", F_TIMO }, @@ -380,8 +339,6 @@ static const struct literal { { "MS_SAVEOFFSET_SIZE", field_sizeof(struct erl_bin_match_struct, save_offset)}, /* messages */ - { "P_MSG_FIRST", offsetof(struct process, msg.first) }, - { "P_MSG_SAVE", offsetof(struct process, msg.save) }, { "MSG_NEXT", offsetof(struct erl_mesg, next) }, /* ARM */ @@ -460,12 +417,14 @@ static const struct atom_literal { * These depend on configuration options such as heap architecture. * The compiler accesses these through hipe_bifs:get_rts_param/1. */ -static const struct rts_param { +struct rts_param { unsigned int nr; const char *name; unsigned int is_defined; int value; -} rts_params[] = { +}; + +static const struct rts_param rts_params[] = { { 1, "P_OFF_HEAP_FUNS", 1, offsetof(struct process, off_heap.first) }, @@ -518,7 +477,53 @@ static const struct rts_param { { 19, "MSG_MESSAGE", 1, offsetof(struct erl_mesg, m[0]) }, - /* highest entry ever used == 21 */ + + /* Field offsets in a process struct */ + { 22, "P_HP", 1, offsetof(struct process, htop) }, + { 23, "P_HP_LIMIT", 1, offsetof(struct process, stop) }, + { 24, "P_OFF_HEAP_FIRST", 1, offsetof(struct process, off_heap.first) }, + { 25, "P_MBUF", 1, offsetof(struct process, mbuf) }, + { 26, "P_ID", 1, offsetof(struct process, common.id) }, + { 27, "P_FLAGS", 1, offsetof(struct process, flags) }, + { 28, "P_FVALUE", 1, offsetof(struct process, fvalue) }, + { 29, "P_FREASON", 1, offsetof(struct process, freason) }, + { 30, "P_FTRACE", 1, offsetof(struct process, ftrace) }, + { 31, "P_FCALLS", 1, offsetof(struct process, fcalls) }, + { 32, "P_BEAM_IP", 1, offsetof(struct process, i) }, + { 33, "P_ARITY", 1, offsetof(struct process, arity) }, + { 34, "P_ARG0", 1, offsetof(struct process, def_arg_reg[0]) }, + { 35, "P_ARG1", 1, offsetof(struct process, def_arg_reg[1]) }, + { 36, "P_ARG2", 1, offsetof(struct process, def_arg_reg[2]) }, + { 37, "P_ARG3", 1, offsetof(struct process, def_arg_reg[3]) }, + { 38, "P_ARG4", 1, offsetof(struct process, def_arg_reg[4]) }, + { 39, "P_ARG5", 1, offsetof(struct process, def_arg_reg[5]) }, + { 40, "P_NSP", 1, offsetof(struct process, hipe.nsp) }, + { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.ncallee) }, + { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.closure) }, + { 43, "P_NSP_LIMIT", 1, offsetof(struct process, hipe.nstack) }, + { 44, "P_CSP", +#if defined(__i386__) || defined(__x86_64__) + 1, offsetof(struct process, hipe.ncsp) +#endif + }, + { 45, "P_NRA", +#if defined(__sparc__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) + 1, offsetof(struct process, hipe.nra) +#endif + }, + { 46, "P_NARITY", 1, offsetof(struct process, hipe.narity) }, + { 47, "P_FLOAT_RESULT", +#ifdef NO_FPE_SIGNALS + 1, offsetof(struct process, hipe.float_result) +#endif + }, + { 48, "P_BIF_CALLEE", +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + 1, offsetof(struct process, hipe.bif_callee) +#endif + }, + { 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) }, + { 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) }, }; #define NR_PARAMS ARRAY_SIZE(rts_params) diff --git a/erts/emulator/hipe/hipe_x86_gc.h b/erts/emulator/hipe/hipe_x86_gc.h index aa4abb6f59..4bea9276c0 100644 --- a/erts/emulator/hipe/hipe_x86_gc.h +++ b/erts/emulator/hipe/hipe_x86_gc.h @@ -71,7 +71,7 @@ nstack_walk_init_sdesc(const Process *p, struct nstack_walk_state *state) state->sdesc0[0].livebits[0] = 0; # ifdef DEBUG state->sdesc0[0].dbg_M = 0; - state->sdesc0[0].dbg_F = am_init; + state->sdesc0[0].dbg_F = am_undefined; state->sdesc0[0].dbg_A = 0; # endif /* XXX: this appears to prevent a gcc-4.1.1 bug on x86 */ diff --git a/erts/emulator/pcre/pcre.mk b/erts/emulator/pcre/pcre.mk index 352137b341..57bf5de2fb 100644 --- a/erts/emulator/pcre/pcre.mk +++ b/erts/emulator/pcre/pcre.mk @@ -49,18 +49,18 @@ PCRE_CFLAGS = $(filter-out -DDEBUG,$(CFLAGS)) -DERLANG_INTEGRATION ifeq ($(TARGET), win32) $(EPCRE_LIB): $(PCRE_OBJS) - $(AR) -out:$@ $(PCRE_OBJS) + $(V_AR) -out:$@ $(PCRE_OBJS) else $(EPCRE_LIB): $(PCRE_OBJS) - $(AR) $(ARFLAGS) $@ $(PCRE_OBJS) + $(V_AR) $(ARFLAGS) $@ $(PCRE_OBJS) -@ ($(RANLIB) $@ || true) 2>/dev/null endif $(PCRE_OBJDIR)/%.o: pcre/%.c - $(CC) -c $(PCRE_CFLAGS) -o $@ $< + $(V_CC) -c $(PCRE_CFLAGS) -o $@ $< $(PCRE_GENINC): pcre/pcre_exec.c - for x in `grep -n COST_CHK pcre/pcre_exec.c | grep -v 'COST_CHK(N)' | awk -F: '{print $$1}'`; \ + $(gen_verbose)for x in `grep -n COST_CHK pcre/pcre_exec.c | grep -v 'COST_CHK(N)' | awk -F: '{print $$1}'`; \ do \ N=`expr $$x + 100`; \ echo "case $$N: goto L_LOOP_COUNT_$${x};"; \ diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index db2854fa40..94f9f76a20 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -57,26 +57,48 @@ /* Implement some other way to get the real page size if needed! */ #endif -#define MAX_CACHE_SIZE 30 - #undef MIN #define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) #undef MAX #define MAX(X, Y) ((X) > (Y) ? (X) : (Y)) -#undef PAGE_MASK -#define INV_PAGE_MASK ((Uint) (page_size - 1)) -#define PAGE_MASK (~INV_PAGE_MASK) -#define PAGE_FLOOR(X) ((X) & PAGE_MASK) -#define PAGE_CEILING(X) PAGE_FLOOR((X) + INV_PAGE_MASK) -#define PAGES(X) ((X) >> page_shift) +#define INV_ALIGNED_MASK ((UWord) ((MSEG_ALIGNED_SIZE) - 1)) +#define ALIGNED_MASK (~INV_ALIGNED_MASK) +#define ALIGNED_FLOOR(X) (((UWord)(X)) & ALIGNED_MASK) +#define ALIGNED_CEILING(X) ALIGNED_FLOOR((X) + INV_ALIGNED_MASK) +#define MAP_IS_ALIGNED(X) (((UWord)(X) & (MSEG_ALIGNED_SIZE - 1)) == 0) + +#define IS_2POW(X) ((X) && !((X) & ((X) - 1))) +static ERTS_INLINE Uint ceil_2pow(Uint x) { + int i = 1 << (4 + (sizeof(Uint) != 4 ? 1 : 0)); + x--; + do { x |= x >> i; } while(i >>= 1); + return x + 1; +} +static const int debruijn[32] = { + 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, + 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 +}; + +#define LOG2(X) (debruijn[((Uint32)(((X) & -(X)) * 0x077CB531U)) >> 27]) + +#define CACHE_AREAS (32 - MSEG_ALIGN_BITS) + +#define SIZE_TO_CACHE_AREA_IDX(S) (LOG2((S)) - MSEG_ALIGN_BITS) +#define MAX_CACHE_SIZE (30) + +#define MSEG_FLG_IS_2POW(X) ((X) & ERTS_MSEG_FLG_2POW) + +#ifdef DEBUG +#define DBG(F,...) fprintf(stderr, (F), __VA_ARGS__ ) +#else +#define DBG(F,...) do{}while(0) +#endif static int atoms_initialized; typedef struct mem_kind_t MemKind; -static void mseg_clear_cache(MemKind*); - #if HALFWORD_HEAP static int initialize_pmmap(void); static void *pmmap(size_t size); @@ -116,15 +138,6 @@ static int mmap_fd; #error "Not supported" #endif /* #if HAVE_MMAP */ -#if defined(ERTS_MSEG_FAKE_SEGMENTS) && HALFWORD_HEAP -# warning "ERTS_MSEG_FAKE_SEGMENTS will only be used for high memory segments" -#endif - -#if defined(ERTS_MSEG_FAKE_SEGMENTS) -#undef CAN_PARTLY_DESTROY -#define CAN_PARTLY_DESTROY 0 -#endif - const ErtsMsegOpt_t erts_mseg_default_opt = { 1, /* Use cache */ 1, /* Preserv data */ @@ -137,26 +150,17 @@ const ErtsMsegOpt_t erts_mseg_default_opt = { }; -typedef struct cache_desc_t_ { - void *seg; - Uint size; - struct cache_desc_t_ *next; - struct cache_desc_t_ *prev; -} cache_desc_t; - typedef struct { Uint32 giga_no; Uint32 no; } CallCounter; -static Uint page_size; -static Uint page_shift; - typedef struct { CallCounter alloc; CallCounter dealloc; CallCounter realloc; CallCounter create; + CallCounter create_resize; CallCounter destroy; #if HAVE_MSEG_RECREATE CallCounter recreate; @@ -165,17 +169,25 @@ typedef struct { CallCounter check_cache; } ErtsMsegCalls; +typedef struct cache_t_ cache_t; + +struct cache_t_ { + Uint size; + void *seg; + cache_t *next; +}; + + typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t; struct mem_kind_t { - cache_desc_t cache_descs[MAX_CACHE_SIZE]; - cache_desc_t *free_cache_descs; - cache_desc_t *cache; - cache_desc_t *cache_end; - - Uint cache_size; - Uint min_cached_seg_size; - Uint max_cached_seg_size; + + cache_t cache[MAX_CACHE_SIZE]; + cache_t *cache_unpowered; + cache_t *cache_area[CACHE_AREAS]; + cache_t *cache_free; + + Sint cache_size; Uint cache_hits; struct { @@ -320,8 +332,7 @@ static erts_mtx_t init_atoms_mutex; /* Also needed when !USE_THREADS */ static ERTS_INLINE void -schedule_cache_check(ErtsMsegAllctr_t *ma) -{ +schedule_cache_check(ErtsMsegAllctr_t *ma) { if (!ma->is_cache_check_scheduled && ma->is_init_done) { erts_set_aux_work_timeout(ma->ix, @@ -331,12 +342,45 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) } } +/* remove ErtsMsegAllctr_t from arguments? + * only used for statistics + */ +static ERTS_INLINE void * +mmap_align(ErtsMsegAllctr_t *ma, void *addr, size_t length, int prot, int flags, int fd, off_t offset) { + + void *p, *q; + UWord d; + + p = mmap(addr, length, prot, flags, fd, offset); + + if (MAP_IS_ALIGNED(p) || p == MAP_FAILED) + return p; + + if (ma) + INC_CC(ma, create_resize); + + munmap(p, length); + + if ((p = mmap(addr, length + MSEG_ALIGNED_SIZE, prot, flags, fd, offset)) == MAP_FAILED) + return MAP_FAILED; + + q = (void *)ALIGNED_CEILING(p); + d = q - p; + + if (d > 0) + munmap(p, d); + + if (MSEG_ALIGNED_SIZE - d > 0) + munmap((void *) (q + length), MSEG_ALIGNED_SIZE - d); + + return q; +} + static ERTS_INLINE void * mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size) { void *seg; - - ASSERT(size % page_size == 0); + ASSERT(size % MSEG_ALIGNED_SIZE == 0); #if HALFWORD_HEAP if (mk == &ma->low_mem) { @@ -345,18 +389,17 @@ mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size) erts_fprintf(stderr,"Pointer mask failure (0x%08lx)\n",(unsigned long) seg); return NULL; } - } - else + } else #endif { -#if defined(ERTS_MSEG_FAKE_SEGMENTS) - seg = erts_sys_alloc(ERTS_ALC_N_INVALID, NULL, size); -#elif HAVE_MMAP +#if HAVE_MMAP { - seg = (void *) mmap((void *) 0, (size_t) size, + seg = (void *) mmap_align(ma, (void *) 0, (size_t) size, MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); if (seg == (void *) MAP_FAILED) seg = NULL; + + ASSERT(MAP_IS_ALIGNED(seg) || !seg); } #else # error "Missing mseg_create() implementation" @@ -369,38 +412,24 @@ mseg_create(ErtsMsegAllctr_t *ma, MemKind* mk, Uint size) } static ERTS_INLINE void -mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size) -{ -#ifdef DEBUG - int res; -#endif +mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size) { + ERTS_DECLARE_DUMMY(int res); #if HALFWORD_HEAP if (mk == &ma->low_mem) { -#ifdef DEBUG - res = -#endif - pmunmap((void *) seg, size); + res = pmunmap((void *) seg, size); } else #endif { -#ifdef ERTS_MSEG_FAKE_SEGMENTS - erts_sys_free(ERTS_ALC_N_INVALID, NULL, seg); -#ifdef DEBUG - res = 0; -#endif -#elif HAVE_MMAP -#ifdef DEBUG - res = -#endif - munmap((void *) seg, size); +#ifdef HAVE_MMAP + res = munmap((void *) seg, size); #else # error "Missing mseg_destroy() implementation" #endif } - ASSERT(size % page_size == 0); + ASSERT(size % MSEG_ALIGNED_SIZE == 0); ASSERT(res == 0); INC_CC(ma, destroy); @@ -408,14 +437,36 @@ mseg_destroy(ErtsMsegAllctr_t *ma, MemKind* mk, void *seg, Uint size) } #if HAVE_MSEG_RECREATE +#if defined(__NetBsd__) +#define MREMAP_FLAGS (0) +#else +#define MREMAP_FLAGS (MREMAP_MAYMOVE) +#endif + + +/* mseg_recreate + * May return *unaligned* segments as in address not aligned to MSEG_ALIGNMENT + * it is still page aligned + * + * This is fine for single block carriers as long as we don't cache misaligned + * segments (since multiblock carriers may use them) + * + * For multiblock carriers we *need* MSEG_ALIGNMENT but mbc's will never be + * reallocated. + * + * This should probably be fixed the following way: + * 1) Use an option to segment allocation - NEED_ALIGNMENT + * 2) Add mremap_align which takes care of aligning a new a mremaped area + * 3) Fix the cache to handle of aligned and unaligned segments + */ static ERTS_INLINE void * mseg_recreate(ErtsMsegAllctr_t *ma, MemKind* mk, void *old_seg, Uint old_size, Uint new_size) { void *new_seg; - ASSERT(old_size % page_size == 0); - ASSERT(new_size % page_size == 0); + ASSERT(old_size % MSEG_ALIGNED_SIZE == 0); + ASSERT(new_size % MSEG_ALIGNED_SIZE == 0); #if HALFWORD_HEAP if (mk == &ma->low_mem) { @@ -426,22 +477,12 @@ mseg_recreate(ErtsMsegAllctr_t *ma, MemKind* mk, void *old_seg, Uint old_size, U else #endif { -#if defined(ERTS_MSEG_FAKE_SEGMENTS) - new_seg = erts_sys_realloc(ERTS_ALC_N_INVALID, NULL, old_seg, new_size); -#elif HAVE_MREMAP - - #if defined(__NetBSD__) - new_seg = (void *) mremap((void *) old_seg, - (size_t) old_size, - NULL, - (size_t) new_size, - 0); - #else - new_seg = (void *) mremap((void *) old_seg, - (size_t) old_size, - (size_t) new_size, - MREMAP_MAYMOVE); - #endif +#if HAVE_MREMAP +#if defined(__NetBSD__) + new_seg = mremap(old_seg, (size_t)old_size, NULL, new_size, MREMAP_FLAGS); +#else + new_seg = mremap(old_seg, (size_t)old_size, (size_t)new_size, MREMAP_FLAGS); +#endif if (new_seg == (void *) MAP_FAILED) new_seg = NULL; #else @@ -475,151 +516,265 @@ do { \ #define ERTS_DBG_MK_CHK_THR_ACCESS(MK) #endif -static ERTS_INLINE cache_desc_t * -alloc_cd(MemKind* mk) -{ - cache_desc_t *cd = mk->free_cache_descs; +/* NEW CACHE interface */ + +static ERTS_INLINE cache_t *mseg_cache_alloc_descriptor(MemKind *mk) { + cache_t *c = mk->cache_free; + ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (cd) - mk->free_cache_descs = cd->next; - return cd; + if (c) + mk->cache_free = c->next; + + return c; } -static ERTS_INLINE void -free_cd(MemKind* mk, cache_desc_t *cd) -{ +static ERTS_INLINE void mseg_cache_free_descriptor(MemKind *mk, cache_t *c) { ERTS_DBG_MK_CHK_THR_ACCESS(mk); - cd->next = mk->free_cache_descs; - mk->free_cache_descs = cd; + ASSERT(c); + + c->seg = NULL; + c->size = 0; + c->next = mk->cache_free; + mk->cache_free = c; } +static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, Uint size) { -static ERTS_INLINE void -link_cd(MemKind* mk, cache_desc_t *cd) -{ + cache_t *c; ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (mk->cache) - mk->cache->prev = cd; - cd->next = mk->cache; - cd->prev = NULL; - mk->cache = cd; - - if (!mk->cache_end) { - ASSERT(!cd->next); - mk->cache_end = cd; + + if (mk->cache_free && MAP_IS_ALIGNED(seg)) { + if (IS_2POW(size)) { + int ix = SIZE_TO_CACHE_AREA_IDX(size); + + ASSERT(ix < CACHE_AREAS); + ASSERT((1 << (ix + MSEG_ALIGN_BITS)) == size); + + /* unlink from free cache list */ + c = mseg_cache_alloc_descriptor(mk); + + /* link to cache area */ + c->seg = seg; + c->size = size; + c->next = mk->cache_area[ix]; + + mk->cache_area[ix] = c; + mk->cache_size++; + + ASSERT(mk->cache_size <= mk->ma->max_cache_size); + + return 1; + } else { + /* unlink from free cache list */ + c = mseg_cache_alloc_descriptor(mk); + + /* link to cache area */ + c->seg = seg; + c->size = size; + c->next = mk->cache_unpowered; + + mk->cache_unpowered = c; + mk->cache_size++; + + ASSERT(mk->cache_size <= mk->ma->max_cache_size); + + return 1; + } } - mk->cache_size++; + return 0; } -#if CAN_PARTLY_DESTROY -static ERTS_INLINE void -end_link_cd(MemKind* mk, cache_desc_t *cd) -{ +static ERTS_INLINE void *cache_get_segment(MemKind *mk, Uint *size_p) { + + Uint size = *size_p; + ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (mk->cache_end) - mk->cache_end->next = cd; - cd->next = NULL; - cd->prev = mk->cache_end; - mk->cache_end = cd; - - if (!mk->cache) { - ASSERT(!cd->prev); - mk->cache = cd; - } + if (IS_2POW(size)) { + + int i, ix = SIZE_TO_CACHE_AREA_IDX(size); + void *seg; + cache_t *c; + Uint csize; + + for( i = ix; i < CACHE_AREAS; i++) { + + if ((c = mk->cache_area[i]) == NULL) + continue; + + ASSERT(IS_2POW(c->size)); + + /* unlink from cache area */ + csize = c->size; + seg = c->seg; + mk->cache_area[i] = c->next; + c->next = NULL; + mk->cache_size--; + mk->cache_hits++; + + /* link to free cache list */ + mseg_cache_free_descriptor(mk, c); + + ASSERT(!(mk->cache_size < 0)); + + /* divvy up the cache - if needed */ + while( i > ix) { + csize = csize >> 1; + /* try to cache half of it */ + if (!cache_bless_segment(mk, (char *)seg + csize, csize)) { + /* wouldn't cache .. destroy it instead */ + mseg_destroy(mk->ma, mk, (char *)seg + csize, csize); + } + i--; + } + ASSERT(csize == size); + return seg; + } + } + else if (mk->cache_unpowered) { + void *seg; + cache_t *c, *pc; + Uint csize; + Uint bad_max_abs = mk->ma->abs_max_cache_bad_fit; + Uint bad_max_rel = mk->ma->rel_max_cache_bad_fit; + + c = mk->cache_unpowered; + pc = c; + + while (c) { + csize = c->size; + if (csize >= size && + ((csize - size)*100 < bad_max_rel*size) && + (csize - size) < bad_max_abs ) { + + /* unlink from cache area */ + seg = c->seg; + + if (pc == c) { + mk->cache_unpowered = c->next; + } else { + pc->next = c->next; + } + + c->next = NULL; + mk->cache_size--; + mk->cache_hits++; + + /* link to free cache list */ + mseg_cache_free_descriptor(mk, c); + *size_p = csize; + + return seg; + } - mk->cache_size++; + pc = c; + c = c->next; + } + } + return NULL; } -#endif -static ERTS_INLINE void -unlink_cd(MemKind* mk, cache_desc_t *cd) -{ - ERTS_DBG_MK_CHK_THR_ACCESS(mk); - if (cd->next) - cd->next->prev = cd->prev; - else - mk->cache_end = cd->prev; - - if (cd->prev) - cd->prev->next = cd->next; - else - mk->cache = cd->next; - ASSERT(mk->cache_size > 0); +/* *_mseg_check_*_cache + * Slowly remove segments cached in the allocator by + * using callbacks from aux-work in the scheduler. + */ + +static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, cache_t **head) { + cache_t *c = NULL; + + c = *head; + + ASSERT( c != NULL ); + + *head = c->next; + + if (erts_mtrace_enabled) + erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); + + mseg_destroy(mk->ma, mk, c->seg, c->size); + mseg_cache_free_descriptor(mk, c); + + mk->segments.current.watermark--; mk->cache_size--; -} -static ERTS_INLINE void -check_cache_limits(MemKind* mk) -{ - cache_desc_t *cd; - ERTS_DBG_MK_CHK_THR_ACCESS(mk); - mk->max_cached_seg_size = 0; - mk->min_cached_seg_size = ~((Uint) 0); - for (cd = mk->cache; cd; cd = cd->next) { - if (cd->size < mk->min_cached_seg_size) - mk->min_cached_seg_size = cd->size; - if (cd->size > mk->max_cached_seg_size) - mk->max_cached_seg_size = cd->size; - } + ASSERT( mk->cache_size >= 0 ); + + return mk->cache_size; } -static ERTS_INLINE void -adjust_cache_size(MemKind* mk, int force_check_limits) -{ - cache_desc_t *cd; - int check_limits = force_check_limits; - Sint max_cached = ((Sint) mk->segments.current.watermark - - (Sint) mk->segments.current.no); - ERTS_DBG_MK_CHK_THR_ACCESS(mk); - while (((Sint) mk->cache_size) > max_cached && ((Sint) mk->cache_size) > 0) { - ASSERT(mk->cache_end); - cd = mk->cache_end; - if (!check_limits && - !(mk->min_cached_seg_size < cd->size - && cd->size < mk->max_cached_seg_size)) { - check_limits = 1; - } +static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, cache_t **head) { + cache_t *c = NULL, *next = NULL; + + c = *head; + ASSERT( c != NULL ); + + while (c) { + + next = c->next; + if (erts_mtrace_enabled) - erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(mk->ma, mk, cd->seg, cd->size); - unlink_cd(mk,cd); - free_cd(mk,cd); - } + erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg); - if (check_limits) - check_cache_limits(mk); -} + mseg_destroy(mk->ma, mk, c->seg, c->size); + mseg_cache_free_descriptor(mk, c); -static Uint -check_one_cache(MemKind* mk) -{ - if (mk->segments.current.watermark > mk->segments.current.no) mk->segments.current.watermark--; - adjust_cache_size(mk, 0); + mk->cache_size--; + + c = next; + } + + *head = NULL; + + ASSERT( mk->cache_size >= 0 ); - if (mk->cache_size) - schedule_cache_check(mk->ma); return mk->cache_size; } -static void do_cache_check(ErtsMsegAllctr_t *ma) -{ - int empty_cache = 1; +/* mseg_check_memkind_cache + * - Check if we can empty some cached segments in this + * MemKind. + */ + + +static Uint mseg_check_memkind_cache(MemKind *mk) { + int i; + + ERTS_DBG_MK_CHK_THR_ACCESS(mk); + + for (i = 0; i < CACHE_AREAS; i++) { + if (mk->cache_area[i] != NULL) + return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_area[i])); + } + + if (mk->cache_unpowered) + return mseg_drop_one_memkind_cache_size(mk, &(mk->cache_unpowered)); + + return 0; +} + +/* mseg_cache_check + * - Check if we have some cache we can purge + * in any of the memkinds. + */ + +static void mseg_cache_check(ErtsMsegAllctr_t *ma) { MemKind* mk; + Uint empty_cache = 1; ERTS_MSEG_LOCK(ma); - for (mk=ma->mk_list; mk; mk=mk->next) { - if (check_one_cache(mk)) + for (mk = ma->mk_list; mk; mk = mk->next) { + if (mseg_check_memkind_cache(mk)) empty_cache = 0; } + /* If all MemKinds caches are empty, + * remove aux-work callback + */ if (empty_cache) { ma->is_cache_check_scheduled = 0; - erts_set_aux_work_timeout(ma->ix, - ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK, - 0); + erts_set_aux_work_timeout(ma->ix, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK, 0); } INC_CC(ma, check_cache); @@ -627,27 +782,65 @@ static void do_cache_check(ErtsMsegAllctr_t *ma) ERTS_MSEG_UNLOCK(ma); } -void erts_mseg_cache_check(void) -{ - do_cache_check(ERTS_MSEG_ALLCTR_SS()); +/* erts_mseg_cache_check + * - This is a callback that is scheduled as aux-work from + * schedulers and is called at some interval if we have a cache + * on this mseg-allocator and memkind. + * - Purpose: Empty cache slowly so we don't collect mapped areas + * and bloat memory. + */ + +void erts_mseg_cache_check(void) { + mseg_cache_check(ERTS_MSEG_ALLCTR_SS()); } -static void -mseg_clear_cache(MemKind* mk) -{ - mk->segments.current.watermark = 0; - adjust_cache_size(mk, 1); +/* *_mseg_clear_*_cache + * Remove cached segments from the allocator completely + */ + +static void mseg_clear_memkind_cache(MemKind *mk) { + int i; + + /* drop pow2 caches */ + for (i = 0; i < CACHE_AREAS; i++) { + if (mk->cache_area[i] == NULL) + continue; + + mseg_drop_memkind_cache_size(mk, &(mk->cache_area[i])); + ASSERT(mk->cache_area[i] == NULL); + } + /* drop varied caches */ + if(mk->cache_unpowered) + mseg_drop_memkind_cache_size(mk, &(mk->cache_unpowered)); + + ASSERT(mk->cache_unpowered == NULL); + ASSERT(mk->cache_size == 0); +} + +static void mseg_clear_cache(ErtsMsegAllctr_t *ma) { + MemKind* mk; + + ERTS_MSEG_LOCK(ma); + ERTS_DBG_MA_CHK_THR_ACCESS(ma); + - ASSERT(!mk->cache); - ASSERT(!mk->cache_end); - ASSERT(!mk->cache_size); + for (mk = ma->mk_list; mk; mk = mk->next) { + mseg_clear_memkind_cache(mk); + } - mk->segments.current.watermark = mk->segments.current.no; + INC_CC(ma, clear_cache); - INC_CC(mk->ma, clear_cache); + ERTS_MSEG_UNLOCK(ma); } +void erts_mseg_clear_cache(void) { + mseg_clear_cache(ERTS_MSEG_ALLCTR_SS()); + mseg_clear_cache(ERTS_MSEG_ALLCTR_IX(0)); +} + + + static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, const ErtsMsegOpt_t *opt) { @@ -660,116 +853,40 @@ static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma, static void * mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, Uint *size_p, - const ErtsMsegOpt_t *opt) + Uint flags, const ErtsMsegOpt_t *opt) { - Uint max, min, diff_size, size; - cache_desc_t *cd, *cand_cd; + Uint size; void *seg; MemKind* mk = memkind(ma, opt); INC_CC(ma, alloc); - size = PAGE_CEILING(*size_p); + /* Carrier align */ + size = ALIGNED_CEILING(*size_p); + + /* Cache optim (if applicable) */ + if (MSEG_FLG_IS_2POW(flags) && !IS_2POW(size)) + size = ceil_2pow(size); #if CAN_PARTLY_DESTROY if (size < ma->min_seg_size) ma->min_seg_size = size; #endif + + if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size)) != NULL) + goto done; - if (!opt->cache) { - create_seg: - adjust_cache_size(mk,0); - seg = mseg_create(ma, mk, size); - if (!seg) { - mseg_clear_cache(mk); - seg = mseg_create(ma, mk, size); - if (!seg) - size = 0; - } - - *size_p = size; - if (seg) { - if (erts_mtrace_enabled) - erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); - ERTS_MSEG_ALLOC_STAT(mk,size); - } - return seg; - } - - if (size > mk->max_cached_seg_size) - goto create_seg; - - if (size < mk->min_cached_seg_size) { - - diff_size = mk->min_cached_seg_size - size; - - if (diff_size > ma->abs_max_cache_bad_fit) - goto create_seg; - - if (100*PAGES(diff_size) > ma->rel_max_cache_bad_fit*PAGES(size)) - goto create_seg; - - } - - max = 0; - min = ~((Uint) 0); - cand_cd = NULL; - - for (cd = mk->cache; cd; cd = cd->next) { - if (cd->size >= size) { - if (!cand_cd) { - cand_cd = cd; - continue; - } - else if (cd->size < cand_cd->size) { - if (max < cand_cd->size) - max = cand_cd->size; - if (min > cand_cd->size) - min = cand_cd->size; - cand_cd = cd; - continue; - } - } - if (max < cd->size) - max = cd->size; - if (min > cd->size) - min = cd->size; - } - - mk->min_cached_seg_size = min; - mk->max_cached_seg_size = max; - - if (!cand_cd) - goto create_seg; - - diff_size = cand_cd->size - size; - - if (diff_size > ma->abs_max_cache_bad_fit - || 100*PAGES(diff_size) > ma->rel_max_cache_bad_fit*PAGES(size)) { - if (mk->max_cached_seg_size < cand_cd->size) - mk->max_cached_seg_size = cand_cd->size; - if (mk->min_cached_seg_size > cand_cd->size) - mk->min_cached_seg_size = cand_cd->size; - goto create_seg; - } - - mk->cache_hits++; - - size = cand_cd->size; - seg = cand_cd->seg; - - unlink_cd(mk,cand_cd); - free_cd(mk,cand_cd); + if ((seg = mseg_create(ma, mk, size)) == NULL) + size = 0; +done: *size_p = size; + if (seg) { + if (erts_mtrace_enabled) + erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); - if (erts_mtrace_enabled) { - erts_mtrace_crr_free(SEGTYPE, SEGTYPE, seg); - erts_mtrace_crr_alloc(seg, atype, SEGTYPE, size); - } - - if (seg) ERTS_MSEG_ALLOC_STAT(mk,size); + } return seg; } @@ -780,73 +897,42 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, Uint size, const ErtsMsegOpt_t *opt) { MemKind* mk = memkind(ma, opt); - cache_desc_t *cd; + ERTS_MSEG_DEALLOC_STAT(mk,size); - if (!opt->cache || ma->max_cache_size == 0) { - if (erts_mtrace_enabled) - erts_mtrace_crr_free(atype, SEGTYPE, seg); - mseg_destroy(ma, mk, seg, size); + if (opt->cache && cache_bless_segment(mk, seg, size)) { + schedule_cache_check(ma); + goto done; } - else { - int check_limits = 0; - - if (size < mk->min_cached_seg_size) - mk->min_cached_seg_size = size; - if (size > mk->max_cached_seg_size) - mk->max_cached_seg_size = size; - - if (!mk->free_cache_descs) { - cd = mk->cache_end; - if (!(mk->min_cached_seg_size < cd->size - && cd->size < mk->max_cached_seg_size)) { - check_limits = 1; - } - if (erts_mtrace_enabled) - erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); - mseg_destroy(ma, mk, cd->seg, cd->size); - unlink_cd(mk,cd); - free_cd(mk,cd); - } - cd = alloc_cd(mk); - ASSERT(cd); - cd->seg = seg; - cd->size = size; - link_cd(mk,cd); + if (erts_mtrace_enabled) + erts_mtrace_crr_free(atype, SEGTYPE, seg); - if (erts_mtrace_enabled) { - erts_mtrace_crr_free(atype, SEGTYPE, seg); - erts_mtrace_crr_alloc(seg, SEGTYPE, SEGTYPE, size); - } - - /* ASSERT(segments.current.watermark >= segments.current.no + cache_size); */ - - if (check_limits) - check_cache_limits(mk); + mseg_destroy(ma, mk, seg, size); - schedule_cache_check(ma); - - } +done: INC_CC(ma, dealloc); } static void * mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, - Uint old_size, Uint *new_size_p, const ErtsMsegOpt_t *opt) + Uint old_size, Uint *new_size_p, Uint flags, const ErtsMsegOpt_t *opt) { MemKind* mk; void *new_seg; Uint new_size; + /* Just allocate a new segment if we didn't have one before */ if (!seg || !old_size) { - new_seg = mseg_alloc(ma, atype, new_size_p, opt); + new_seg = mseg_alloc(ma, atype, new_size_p, flags, opt); DEC_CC(ma, alloc); return new_seg; } + + /* Dealloc old segment if new segment is of size 0 */ if (!(*new_size_p)) { mseg_dealloc(ma, atype, seg, old_size, opt); DEC_CC(ma, dealloc); @@ -855,7 +941,13 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, mk = memkind(ma, opt); new_seg = seg; - new_size = PAGE_CEILING(*new_size_p); + + /* Carrier align */ + new_size = ALIGNED_CEILING(*new_size_p); + + /* Cache optim (if applicable) */ + if (MSEG_FLG_IS_2POW(flags) && !IS_2POW(new_size)) + new_size = ceil_2pow(new_size); if (new_size == old_size) ; @@ -866,53 +958,27 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, if (new_size < ma->min_seg_size) ma->min_seg_size = new_size; #endif - + /* +M<S>rsbcst <ratio> */ if (shrink_sz < opt->abs_shrink_th - && 100*PAGES(shrink_sz) < opt->rel_shrink_th*PAGES(old_size)) { + && 100*shrink_sz < opt->rel_shrink_th*old_size) { new_size = old_size; } else { #if CAN_PARTLY_DESTROY - if (shrink_sz > ma->min_seg_size - && mk->free_cache_descs - && opt->cache) { - cache_desc_t *cd; - - cd = alloc_cd(mk); - ASSERT(cd); - cd->seg = ((char *) seg) + new_size; - cd->size = shrink_sz; - end_link_cd(mk,cd); - - if (erts_mtrace_enabled) { - erts_mtrace_crr_realloc(new_seg, - atype, - SEGTYPE, - seg, - new_size); - erts_mtrace_crr_alloc(cd->seg, SEGTYPE, SEGTYPE, cd->size); - } - schedule_cache_check(ma); - } - else { - if (erts_mtrace_enabled) - erts_mtrace_crr_realloc(new_seg, - atype, - SEGTYPE, - seg, - new_size); - mseg_destroy(ma, mk, ((char *) seg) + new_size, shrink_sz); - } + if (erts_mtrace_enabled) + erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); -#elif HAVE_MSEG_RECREATE + mseg_destroy(ma, mk, ((char *) seg) + new_size, shrink_sz); +#elif HAVE_MSEG_RECREATE goto do_recreate; - #else + new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); + + ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); - new_seg = mseg_alloc(ma, atype, &new_size, opt); if (!new_seg) new_size = old_size; else { @@ -921,16 +987,15 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, MIN(new_size, old_size)); mseg_dealloc(ma, atype, seg, old_size, opt); } - #endif - } } else { if (!opt->preserv) { mseg_dealloc(ma, atype, seg, old_size, opt); - new_seg = mseg_alloc(ma, atype, &new_size, opt); + new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); + ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); } else { #if HAVE_MSEG_RECREATE @@ -938,18 +1003,23 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, do_recreate: #endif new_seg = mseg_recreate(ma, mk, (void *) seg, old_size, new_size); + /* ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); + * will not always be aligned and it ok for now + */ + if (erts_mtrace_enabled) erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); if (!new_seg) new_size = old_size; #else - new_seg = mseg_alloc(ma, atype, &new_size, opt); + new_seg = mseg_alloc(ma, atype, &new_size, flags, opt); + + ASSERT(MAP_IS_ALIGNED(new_seg) || !new_seg); + if (!new_seg) new_size = old_size; else { - sys_memcpy(((char *) new_seg), - ((char *) seg), - MIN(new_size, old_size)); + sys_memcpy(((char *) new_seg), ((char *) seg), MIN(new_size, old_size)); mseg_dealloc(ma, atype, seg, old_size, opt); } #endif @@ -958,6 +1028,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, INC_CC(ma, realloc); + ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size)); *new_size_p = new_size; ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size); @@ -990,6 +1061,7 @@ static struct { Eterm mseg_dealloc; Eterm mseg_realloc; Eterm mseg_create; + Eterm mseg_create_resize; Eterm mseg_destroy; #if HAVE_MSEG_RECREATE Eterm mseg_recreate; @@ -1046,6 +1118,7 @@ init_atoms(ErtsMsegAllctr_t *ma) AM_INIT(mseg_dealloc); AM_INIT(mseg_realloc); AM_INIT(mseg_create); + AM_INIT(mseg_create_resize); AM_INIT(mseg_destroy); #if HAVE_MSEG_RECREATE AM_INIT(mseg_recreate); @@ -1065,14 +1138,12 @@ init_atoms(ErtsMsegAllctr_t *ma) erts_mtx_unlock(&init_atoms_mutex); } - #define bld_uint erts_bld_uint #define bld_cons erts_bld_cons #define bld_tuple erts_bld_tuple #define bld_string erts_bld_string #define bld_2tup_list erts_bld_2tup_list - /* * bld_unstable_uint() (instead of bld_uint()) is used when values may * change between size check and actual build. This because a value @@ -1116,6 +1187,7 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp, *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 4, el1, el2, el3, el4), *lp); } + static Eterm info_options(ErtsMsegAllctr_t *ma, char *prefix, @@ -1176,6 +1248,7 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp PRINT_CC(to, arg, dealloc); PRINT_CC(to, arg, realloc); PRINT_CC(to, arg, create); + PRINT_CC(to, arg, create_resize); PRINT_CC(to, arg, destroy); #if HAVE_MSEG_RECREATE PRINT_CC(to, arg, recreate); @@ -1215,6 +1288,10 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp bld_unstable_uint(hpp, szp, ma->calls.create.giga_no), bld_unstable_uint(hpp, szp, ma->calls.create.no)); + add_3tup(hpp, szp, &res, + am.mseg_create_resize, + bld_unstable_uint(hpp, szp, ma->calls.create_resize.giga_no), + bld_unstable_uint(hpp, szp, ma->calls.create_resize.no)); add_3tup(hpp, szp, &res, am.mseg_realloc, @@ -1401,21 +1478,21 @@ erts_mseg_info(int ix, } void * -erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) +erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, Uint flags, const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); void *seg; ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); - seg = mseg_alloc(ma, atype, size_p, opt); + seg = mseg_alloc(ma, atype, size_p, flags, opt); ERTS_MSEG_UNLOCK(ma); return seg; } void * -erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p) +erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p, Uint flags) { - return erts_mseg_alloc_opt(atype, size_p, &erts_mseg_default_opt); + return erts_mseg_alloc_opt(atype, size_p, flags, &erts_mseg_default_opt); } void @@ -1438,44 +1515,24 @@ erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size) void * erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, + Uint flags, const ErtsMsegOpt_t *opt) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt); void *new_seg; ERTS_MSEG_LOCK(ma); ERTS_DBG_MA_CHK_THR_ACCESS(ma); - new_seg = mseg_realloc(ma, atype, seg, old_size, new_size_p, opt); + new_seg = mseg_realloc(ma, atype, seg, old_size, new_size_p, flags, opt); ERTS_MSEG_UNLOCK(ma); return new_seg; } void * erts_mseg_realloc(ErtsAlcType_t atype, void *seg, - Uint old_size, Uint *new_size_p) + Uint old_size, Uint *new_size_p, Uint flags) { return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p, - &erts_mseg_default_opt); -} - -void -erts_mseg_clear_cache(void) -{ - ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_SS(); - MemKind* mk; - -start: - - ERTS_MSEG_LOCK(ma); - ERTS_DBG_MA_CHK_THR_ACCESS(ma); - for (mk=ma->mk_list; mk; mk=mk->next) { - mseg_clear_cache(mk); - } - ERTS_MSEG_UNLOCK(ma); - - if (ma->ix != 0) { - ma = ERTS_MSEG_ALLCTR_IX(0); - goto start; - } + flags, &erts_mseg_default_opt); } Uint @@ -1496,28 +1553,32 @@ erts_mseg_no(const ErtsMsegOpt_t *opt) Uint erts_mseg_unit_size(void) { - return page_size; + return MSEG_ALIGNED_SIZE; } static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name) { - unsigned i; + int i; - mk->cache = NULL; - mk->cache_end = NULL; - mk->max_cached_seg_size = 0; - mk->min_cached_seg_size = ~((Uint) 0); - mk->cache_size = 0; - mk->cache_hits = 0; + for (i = 0; i < CACHE_AREAS; i++) { + mk->cache_area[i] = NULL; + } + + mk->cache_free = NULL; - if (ma->max_cache_size > 0) { - for (i = 0; i < ma->max_cache_size - 1; i++) - mk->cache_descs[i].next = &mk->cache_descs[i + 1]; - mk->cache_descs[ma->max_cache_size - 1].next = NULL; - mk->free_cache_descs = &mk->cache_descs[0]; + ASSERT(ma->max_cache_size <= MAX_CACHE_SIZE); + + for (i = 0; i < ma->max_cache_size; i++) { + mk->cache[i].seg = NULL; + mk->cache[i].size = 0; + mk->cache[i].next = mk->cache_free; + mk->cache_free = &(mk->cache[i]); } - else - mk->free_cache_descs = NULL; + + mk->cache_unpowered = NULL; + + mk->cache_size = 0; + mk->cache_hits = 0; mk->segments.current.watermark = 0; mk->segments.current.no = 0; @@ -1570,15 +1631,10 @@ erts_mseg_init(ErtsMsegInit_t *init) initialize_pmmap(); #endif - page_size = GET_PAGE_SIZE; + if (!IS_2POW(GET_PAGE_SIZE)) + erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE); - page_shift = 1; - while ((page_size >> page_shift) != 1) { - if ((page_size & (1 << (page_shift - 1))) != 0) - erl_exit(ERTS_ABORT_EXIT, - "erts_mseg: Unexpected page_size %beu\n", page_size); - page_shift++; - } + ASSERT((MSEG_ALIGNED_SIZE % GET_PAGE_SIZE) == 0); for (i = 0; i < no_mseg_allocators; i++) { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(i); @@ -1663,7 +1719,7 @@ erts_mseg_test(unsigned long op, case 0x400: /* Have erts_mseg */ return (unsigned long) 1; case 0x401: - return (unsigned long) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1); + return (unsigned long) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1, (Uint) 0); case 0x402: erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2); return (unsigned long) 0; @@ -1671,7 +1727,8 @@ erts_mseg_test(unsigned long op, return (unsigned long) erts_mseg_realloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, - (Uint *) a3); + (Uint *) a3, + (Uint) 0); case 0x404: erts_mseg_clear_cache(); return (unsigned long) 0; @@ -1707,7 +1764,40 @@ erts_mseg_test(unsigned long op, * mapping tricks. */ -/*#define HARDDEBUG 1*/ +/* #define HARDDEBUG 1 */ + +#ifdef HARDDEBUG +static void dump_freelist(void) +{ + FreeBlock *p = first; + + while (p) { + fprintf(stderr, "p = %p\r\np->num = %ld\r\np->next = %p\r\n\r\n", + (void *) p, (unsigned long) p->num, (void *) p->next); + p = p->next; + } +} + +#define HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(PTR, SZ) \ + fprintf(stderr,"Mapping of address %p with size %ld " \ + "does not map complete pages (%s:%d)\r\n", \ + (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__) + +#define HARDDEBUG_HW_UNALIGNED_ALIGNMENT(PTR, SZ) \ + fprintf(stderr,"Mapping of address %p with size %ld " \ + "is not page aligned (%s:%d)\r\n", \ + (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__) + +#define HARDDEBUG_MAP_FAILED(PTR, SZ) \ + fprintf(stderr, "Could not actually map memory " \ + "at address %p with size %ld (%s:%d) ..\r\n", \ + (void *) (PTR), (unsigned long) (SZ),__FILE__, __LINE__) +#else +#define HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(PTR, SZ) do{}while(0) +#define HARDDEBUG_HW_UNALIGNED_ALIGNMENT(PTR, SZ) do{}while(0) +#define HARDDEBUG_MAP_FAILED(PTR, SZ) do{}while(0) +#endif + #ifdef __APPLE__ #define MAP_ANONYMOUS MAP_ANON @@ -1726,49 +1816,20 @@ typedef struct _free_block { struct _free_block *next; } FreeBlock; -/* Assigned once and for all */ -static size_t pagsz; - /* Protect with lock */ static FreeBlock *first; -static size_t round_up_to_pagesize(size_t size) -{ - size_t x = size / pagsz; - - if ((size % pagsz)) { - ++x; - } - - return pagsz * x; -} - -static size_t round_down_to_pagesize(size_t size) -{ - size_t x = size / pagsz; - - return pagsz * x; -} - static void *do_map(void *ptr, size_t sz) { void *res; - if (round_up_to_pagesize(sz) != sz) { -#ifdef HARDDEBUG - fprintf(stderr,"Mapping of address %p with size %ld " - "does not map complete pages\r\n", - (void *) ptr, (unsigned long) sz); -#endif + if (ALIGNED_CEILING(sz) != sz) { + HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(ptr, sz); return NULL; } - if (((unsigned long) ptr) % pagsz) { -#ifdef HARDDEBUG - fprintf(stderr,"Mapping of address %p with size %ld " - "is not page aligned\r\n", - (void *) ptr, (unsigned long) sz); -#endif + if (((unsigned long) ptr) % MSEG_ALIGNED_SIZE) { + HARDDEBUG_HW_UNALIGNED_ALIGNMENT(ptr, sz); return NULL; } @@ -1782,10 +1843,7 @@ static void *do_map(void *ptr, size_t sz) #endif if (res == MAP_FAILED) { -#ifdef HARDDEBUG - fprintf(stderr,"Mapping of address %p with size %ld failed!\r\n", - (void *) ptr, (unsigned long) sz); -#endif + HARDDEBUG_MAP_FAILED(ptr, sz); return NULL; } @@ -1796,35 +1854,22 @@ static int do_unmap(void *ptr, size_t sz) { void *res; - if (round_up_to_pagesize(sz) != sz) { -#ifdef HARDDEBUG - fprintf(stderr,"Mapping of address %p with size %ld " - "does not map complete pages\r\n", - (void *) ptr, (unsigned long) sz); -#endif + if (ALIGNED_CEILING(sz) != sz) { + HARDDEBUG_HW_INCOMPLETE_ALIGNMENT(ptr, sz); return 1; } - if (((unsigned long) ptr) % pagsz) { -#ifdef HARDDEBUG - fprintf(stderr,"Mapping of address %p with size %ld " - "is not page aligned\r\n", - (void *) ptr, (unsigned long) sz); -#endif + if (((unsigned long) ptr) % MSEG_ALIGNED_SIZE) { + HARDDEBUG_HW_UNALIGNED_ALIGNMENT(ptr, sz); return 1; } - res = mmap(ptr, sz, - PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE - | MAP_FIXED, + PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE | MAP_FIXED, -1 , 0); if (res == MAP_FAILED) { -#ifdef HARDDEBUG - fprintf(stderr,"Mapping of address %p with size %ld failed!\r\n", - (void *) ptr, (unsigned long) sz); -#endif + HARDDEBUG_MAP_FAILED(ptr, sz); return 1; } @@ -1862,8 +1907,6 @@ static int initialize_pmmap(void) size_t rsz; FreeBlock *initial; - - pagsz = getpagesize(); SET_RANGE_MIN(); if (sizeof(void *) != 8) { erl_exit(1,"Halfword emulator cannot be run in 32bit mode"); @@ -1872,15 +1915,15 @@ static int initialize_pmmap(void) p = (char *) RANGE_MIN; q = (char *) RANGE_MAX; - rsz = round_down_to_pagesize(q - p); + rsz = ALIGNED_FLOOR(q - p); - rptr = mmap((void *) p, rsz, + rptr = mmap_align(NULL, (void *) p, rsz, PROT_NONE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE | EXTRA_MAP_FLAGS, -1 , 0); #ifdef HARDDEBUG printf("p=%p, rsz = %ld, pages = %ld, got range = %p -> %p\r\n", - p, (unsigned long) rsz, (unsigned long) (rsz / pagsz), + p, (unsigned long) rsz, (unsigned long) (rsz / MSEG_ALIGNED_SIZE), (void *) rptr, (void*)(rptr + rsz)); #endif if ((UWord)(rptr + rsz) > RANGE_MAX) { @@ -1892,39 +1935,27 @@ static int initialize_pmmap(void) munmap((void*)RANGE_MAX, rsz - rsz_trunc); rsz = rsz_trunc; } - if (!do_map(rptr,pagsz)) { + if (!do_map(rptr, MSEG_ALIGNED_SIZE)) { erl_exit(1,"Could not actually mmap first page for halfword emulator...\n"); } initial = (FreeBlock *) rptr; - initial->num = (rsz / pagsz); + initial->num = (rsz / MSEG_ALIGNED_SIZE); initial->next = NULL; first = initial; INIT_LOCK(); return 0; } -#ifdef HARDDEBUG -static void dump_freelist(void) -{ - FreeBlock *p = first; - - while (p) { - printf("p = %p\r\np->num = %ld\r\np->next = %p\r\n\r\n", - (void *) p, (unsigned long) p->num, (void *) p->next); - p = p->next; - } -} -#endif - - static void *pmmap(size_t size) { - size_t real_size = round_up_to_pagesize(size); - size_t num_pages = real_size / pagsz; + size_t real_size = ALIGNED_CEILING(size); + size_t num_pages = real_size / MSEG_ALIGNED_SIZE; FreeBlock **block; FreeBlock *tail; FreeBlock *res; + TAKE_LOCK(); + for (block = &first; *block != NULL && (*block)->num < num_pages; block = &((*block)->next)) @@ -1935,29 +1966,25 @@ static void *pmmap(size_t size) } if ((*block)->num == num_pages) { /* nice, perfect fit */ - res = *block; + res = *block; *block = (*block)->next; } else { tail = (FreeBlock *) (((char *) ((void *) (*block))) + real_size); - if (!do_map(tail,pagsz)) { -#ifdef HARDDEBUG - fprintf(stderr, "Could not actually allocate page at %p...\r\n", - (void *) tail); -#endif + if (!do_map(tail, MSEG_ALIGNED_SIZE)) { + HARDDEBUG_MAP_FAILED(tail, MSEG_ALIGNED_SIZE); RELEASE_LOCK(); return NULL; } - tail->num = (*block)->num - num_pages; + tail->num = (*block)->num - num_pages; tail->next = (*block)->next; res = *block; *block = tail; } + RELEASE_LOCK(); - if (!do_map(res,real_size)) { -#ifdef HARDDEBUG - fprintf(stderr, "Could not actually allocate %ld at %p...\r\n", - (unsigned long) real_size, (void *) res); -#endif + + if (!do_map(res, real_size)) { + HARDDEBUG_MAP_FAILED(res, real_size); return NULL; } @@ -1966,15 +1993,17 @@ static void *pmmap(size_t size) static int pmunmap(void *p, size_t size) { - size_t real_size = round_up_to_pagesize(size); - size_t num_pages = real_size / pagsz; + size_t real_size = ALIGNED_CEILING(size); + size_t num_pages = real_size / MSEG_ALIGNED_SIZE; + FreeBlock *block; FreeBlock *last; FreeBlock *nb = (FreeBlock *) p; ASSERT(((unsigned long)p & CHECK_POINTER_MASK)==0); - if (real_size > pagsz) { - if (do_unmap(((char *) p) + pagsz,real_size - pagsz)) { + + if (real_size > MSEG_ALIGNED_SIZE) { + if (do_unmap(((char *) p) + MSEG_ALIGNED_SIZE, real_size - MSEG_ALIGNED_SIZE)) { return 1; } } @@ -1993,7 +2022,7 @@ static int pmunmap(void *p, size_t size) /* Merge new free block with following */ nb->num = block->num + num_pages; nb->next = block->next; - if (do_unmap(block,pagsz)) { + if (do_unmap(block, MSEG_ALIGNED_SIZE)) { RELEASE_LOCK(); return 1; } @@ -2003,11 +2032,11 @@ static int pmunmap(void *p, size_t size) nb->next = block; } if (last != NULL) { - if (p == ((void *) (((char *) last) + (last->num * pagsz)))) { + if (p == ((void *) (((char *) last) + (last->num * MSEG_ALIGNED_SIZE)))) { /* Merge with previous */ last->num += nb->num; last->next = nb->next; - if (do_unmap(nb,pagsz)) { + if (do_unmap(nb, MSEG_ALIGNED_SIZE)) { RELEASE_LOCK(); return 1; } @@ -2024,10 +2053,10 @@ static int pmunmap(void *p, size_t size) static void *pmremap(void *old_address, size_t old_size, size_t new_size) { - size_t new_real_size = round_up_to_pagesize(new_size); - size_t new_num_pages = new_real_size / pagsz; - size_t old_real_size = round_up_to_pagesize(old_size); - size_t old_num_pages = old_real_size / pagsz; + size_t new_real_size = ALIGNED_CEILING(new_size); + size_t new_num_pages = new_real_size / MSEG_ALIGNED_SIZE; + size_t old_real_size = ALIGNED_CEILING(old_size); + size_t old_num_pages = old_real_size / MSEG_ALIGNED_SIZE; if (new_num_pages == old_num_pages) { return old_address; } else if (new_num_pages < old_num_pages) { /* Shrink */ @@ -2045,8 +2074,8 @@ static void *pmremap(void *old_address, size_t old_size, (*block) > ((FreeBlock *)(((char *) vnfb) + nfb_real_size))) { /* Normal link in */ if (nfb_pages > 1) { - if (do_unmap((void *)(((char *) vnfb) + pagsz), - (nfb_pages - 1)*pagsz)) { + if (do_unmap((void *)(((char *) vnfb) + MSEG_ALIGNED_SIZE), + (nfb_pages - 1)*MSEG_ALIGNED_SIZE)) { return NULL; } } @@ -2058,8 +2087,8 @@ static void *pmremap(void *old_address, size_t old_size, nfb->num = nfb_pages + (*block)->num; /* unmap also the first page of the next freeblock */ (*block) = nfb; - if (do_unmap((void *)(((char *) vnfb) + pagsz), - nfb_pages*pagsz)) { + if (do_unmap((void *)(((char *) vnfb) + MSEG_ALIGNED_SIZE), + nfb_pages*MSEG_ALIGNED_SIZE)) { return NULL; } } @@ -2094,9 +2123,9 @@ static void *pmremap(void *old_address, size_t old_size, size_t remaining_pages = (*block)->num - (new_num_pages - old_num_pages); if (!remaining_pages) { - void *p = (void *) (((char *) (*block)) + pagsz); + void *p = (void *) (((char *) (*block)) + MSEG_ALIGNED_SIZE); void *n = (*block)->next; - size_t x = ((*block)->num - 1) * pagsz; + size_t x = ((*block)->num - 1) * MSEG_ALIGNED_SIZE; if (x > 0) { if (do_map(p,x) == NULL) { RELEASE_LOCK(); @@ -2108,7 +2137,7 @@ static void *pmremap(void *old_address, size_t old_size, FreeBlock *nfb = (FreeBlock *) ((void *) (((char *) old_address) + new_real_size)); - void *p = (void *) (((char *) (*block)) + pagsz); + void *p = (void *) (((char *) (*block)) + MSEG_ALIGNED_SIZE); if (do_map(p,new_real_size - old_real_size) == NULL) { RELEASE_LOCK(); return NULL; @@ -2122,5 +2151,4 @@ static void *pmremap(void *old_address, size_t old_size, } } } - #endif /* HALFWORD_HEAP */ diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 741080fb78..6f373f13f9 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -32,12 +32,35 @@ #if HAVE_MMAP # define HAVE_ERTS_MSEG 1 +# define HAVE_SUPER_ALIGNED_MB_CARRIERS 1 #else # define HAVE_ERTS_MSEG 0 +# define HAVE_SUPER_ALIGNED_MB_CARRIERS 0 +#endif + +#if HAVE_SUPER_ALIGNED_MB_CARRIERS +# define MSEG_ALIGN_BITS (18) + /* Affects hard limits for sbct and lmbcs documented in erts_alloc.xml */ +#else +/* If we don't use super aligned multiblock carriers + * we will mmap with page size alignment (and thus use corresponding + * align bits). + * + * Current implementation needs this to be a constant and + * only uses this for user dev testing so setting page size + * to 4096 (12 bits) is fine. + */ +# define MSEG_ALIGN_BITS (12) #endif #if HAVE_ERTS_MSEG +#define MSEG_ALIGNED_SIZE (1 << MSEG_ALIGN_BITS) + +#define ERTS_MSEG_FLG_NONE ((Uint)(0)) +#define ERTS_MSEG_FLG_2POW ((Uint)(1 << 0)) + + #define ERTS_MSEG_VSN_STR "0.9" typedef struct { @@ -68,13 +91,13 @@ typedef struct { extern const ErtsMsegOpt_t erts_mseg_default_opt; -void *erts_mseg_alloc(ErtsAlcType_t, Uint *); -void *erts_mseg_alloc_opt(ErtsAlcType_t, Uint *, const ErtsMsegOpt_t *); +void *erts_mseg_alloc(ErtsAlcType_t, Uint *, Uint); +void *erts_mseg_alloc_opt(ErtsAlcType_t, Uint *, Uint, const ErtsMsegOpt_t *); void erts_mseg_dealloc(ErtsAlcType_t, void *, Uint); void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, Uint, const ErtsMsegOpt_t *); -void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *); +void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *, Uint); void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, - const ErtsMsegOpt_t *); + Uint, const ErtsMsegOpt_t *); void erts_mseg_clear_cache(void); void erts_mseg_cache_check(void); Uint erts_mseg_no( const ErtsMsegOpt_t *); diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index cd4a91d34a..c0396ddb61 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -60,9 +60,9 @@ typedef void* erts_cond; #define IS_MMAP_C(C) ((Ulong) ALC_TEST1(0x00a, (C))) #define C_SZ(C) ((Ulong) ALC_TEST1(0x00b, (C))) #define SBC2BLK(A, C) ((Block_t *) ALC_TEST2(0x00c, (A), (C))) -#define BLK2SBC(A, B) ((Carrier_t *) ALC_TEST2(0x00d, (A), (B))) -#define MBC2FBLK(A, C) ((Block_t *) ALC_TEST2(0x00e, (A), (C))) -#define FBLK2MBC(A, B) ((Carrier_t *) ALC_TEST2(0x00f, (A), (B))) +#define BLK_TO_SBC(A, B) ((Carrier_t *) ALC_TEST2(0x00d, (A), (B))) +#define MBC_TO_FIRST_BLK(A, C) ((Block_t *) ALC_TEST2(0x00e, (A), (C))) +#define FIRST_BLK_TO_MBC(A, B) ((Carrier_t *) ALC_TEST2(0x00f, (A), (B))) #define FIRST_MBC(A) ((Carrier_t *) ALC_TEST1(0x010, (A))) #define LAST_MBC(A) ((Carrier_t *) ALC_TEST1(0x011, (A))) #define FIRST_SBC(A) ((Carrier_t *) ALC_TEST1(0x012, (A))) @@ -73,7 +73,7 @@ typedef void* erts_cond; #define MIN_BLK_SZ(A) ((Ulong) ALC_TEST1(0x017, (A))) #define NXT_BLK(B) ((Block_t *) ALC_TEST1(0x018, (B))) #define PREV_BLK(B) ((Block_t *) ALC_TEST1(0x019, (B))) -#define IS_FIRST_BLK(B) ((Ulong) ALC_TEST1(0x01a, (B))) +#define IS_MBC_FIRST_BLK(A,B) ((Ulong) ALC_TEST2(0x01a, (A), (B))) #define UNIT_SZ ((Ulong) ALC_TEST0(0x01b)) /* From erl_goodfit_alloc.c */ diff --git a/erts/emulator/test/alloc_SUITE_data/basic.c b/erts/emulator/test/alloc_SUITE_data/basic.c index 4a5e888161..0c27665712 100644 --- a/erts/emulator/test/alloc_SUITE_data/basic.c +++ b/erts/emulator/test/alloc_SUITE_data/basic.c @@ -44,7 +44,7 @@ testcase_run(TestCaseState_t *tcs) c = FIRST_MBC(a); ASSERT(tcs, !NEXT_C(c)); - blk = MBC2FBLK(a, c); + blk = MBC_TO_FIRST_BLK(a, c); ASSERT(tcs, IS_LAST_BLK(blk)); ASSERT(tcs, IS_FREE_BLK(blk)); diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c index b214f87e4a..34979cacf1 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c @@ -22,7 +22,7 @@ #include "allocator_test.h" #include <stdio.h> -#ifdef __WIN32__ && SIZEOF_VOID_P == 8 +#if defined(__WIN32__) && SIZEOF_VOID_P == 8 /* Use larger threashold for win64 as block alignment is 16 bytes and not 8 */ #define SBCT ((1024*1024)) @@ -48,10 +48,16 @@ testcase_cleanup(TestCaseState_t *tcs) void testcase_run(TestCaseState_t *tcs) { - void *tmp; - void **fence; + typedef struct linked_block { + struct linked_block* next; + }Linked; + Linked* link; + Linked* fence_list; + Linked* pad_list; + void* tmp; void **blk; Ulong sz; + Ulong residue; Ulong smbcs; int i; int bi; @@ -73,7 +79,7 @@ testcase_run(TestCaseState_t *tcs) ASSERT(tcs, a); min_blk_sz = MIN_BLK_SZ(a); - smbcs = 2*(no_bkts*sizeof(void *) + min_blk_sz) + min_blk_sz; + smbcs = (no_bkts*sizeof(void *) + min_blk_sz) + min_blk_sz; for (i = 0; i < no_bkts; i++) { sz = BKT_MIN_SZ(a, i); if (sz >= sbct) @@ -98,26 +104,42 @@ testcase_run(TestCaseState_t *tcs) tcs->extra = (void *) a; ASSERT(tcs, a); + blk = (void **) ALLOC(a, no_bkts*sizeof(void *)); - fence = (void **) ALLOC(a, no_bkts*sizeof(void *)); - ASSERT(tcs, blk && fence); + ASSERT(tcs, blk); + fence_list = NULL; testcase_printf(tcs, "Allocating blocks and fences\n"); for (i = 0; i < bi_tests; i++) { sz = BKT_MIN_SZ(a, i); blk[i] = ALLOC(a, sz - ablk_hdr_sz); - fence[i] = ALLOC(a, 1); - ASSERT(tcs, blk[i] && fence[i]); + link = (Linked*) ALLOC(a, sizeof(Linked)); + ASSERT(tcs, blk[i] && link); + link->next = fence_list; + fence_list = link; } - tmp = (void *) UMEM2BLK(fence[bi_tests - 1]); - tmp = (void *) NXT_BLK((Block_t *) tmp); - ASSERT(tcs, IS_LAST_BLK(tmp)); - sz = BLK_SZ((Block_t *) tmp); - testcase_printf(tcs, "Allocating leftover size = %lu\n", sz); - tmp = ALLOC(a, sz - ablk_hdr_sz); - ASSERT(tcs, tmp); + pad_list = 0; + do { + tmp = (void *) UMEM2BLK(link); /* last allocated */ + tmp = (void *) NXT_BLK((Block_t *) tmp); + ASSERT(tcs, IS_LAST_BLK(tmp)); + sz = BLK_SZ((Block_t *) tmp); + if (sz >= sbct) { + residue = sz; + sz = sbct - min_blk_sz; + residue -= sz; + } + else { + residue = 0; + } + testcase_printf(tcs, "Allocating leftover size = %lu, residue = %lu\n", sz, residue); + link = (Linked*) ALLOC(a, sz - ablk_hdr_sz); + ASSERT(tcs, link); + link->next = pad_list; + pad_list = link; + } while (residue); bi = FIND_BKT(a, 0); ASSERT(tcs, bi < 0); @@ -135,16 +157,23 @@ testcase_run(TestCaseState_t *tcs) for (i = 0; i < bi_tests; i++) { FREE(a, blk[i]); - FREE(a, fence[i]); + } + while (fence_list) { + link = fence_list; + fence_list = link->next; + FREE(a, link); } FREE(a, (void *) blk); - FREE(a, (void *) fence); bi = FIND_BKT(a, 0); ASSERT(tcs, bi == no_bkts - 1); - FREE(a, tmp); + while (pad_list) { + link = pad_list; + pad_list = link->next; + FREE(a, link); + } bi = FIND_BKT(a, 0); ASSERT(tcs, bi < 0); diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c index 6f35d3279b..981fa6d43e 100644 --- a/erts/emulator/test/alloc_SUITE_data/coalesce.c +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -54,7 +54,7 @@ setup_sequence(TestCaseState_t *tcs, Allctr_t *a, Ulong bsz, int no, no, bsz); c = FIRST_MBC(a); ASSERT(tcs, !NEXT_C(c)); - blk = MBC2FBLK(a, c); + blk = MBC_TO_FIRST_BLK(a, c); ASSERT(tcs, IS_LAST_BLK(blk)); for (i = 0; i < no; i++) @@ -266,7 +266,7 @@ testcase_name(void) void testcase_run(TestCaseState_t *tcs) { - char *argv_org[] = {"-tmmbcs1024", "-tsbct2048", "-trmbcmt100", "-tas", NULL, NULL}; + char *argv_org[] = {"-tsmbcs511","-tmmbcs511", "-tsbct512", "-trmbcmt100", "-tas", NULL, NULL}; char *alg[] = {"af", "gf", "bf", "aobf", "aoff", NULL}; int i; @@ -276,7 +276,7 @@ testcase_run(TestCaseState_t *tcs) char *argv[sizeof(argv_org)/sizeof(argv_org[0])]; memcpy((void *) argv, (void *) argv_org, sizeof(argv_org)); - argv[4] = alg[i]; + argv[5] = alg[i]; testcase_printf(tcs, " *** Starting \"%s\" allocator *** \n", alg[i]); a = START_ALC("coalesce_", 0, argv); ASSERT(tcs, a); diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c index 0277616bd0..7d5608f890 100644 --- a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c @@ -52,10 +52,10 @@ testcase_run(TestCaseState_t *tcs) tcs->extra = &seg[0]; for (i = 0; i < MAX_SEGS; i++) { - seg[i].size = 1000; + seg[i].size = 1 << 18; seg[i].ptr = MSEG_ALLOC(&seg[i].size); ASSERT(tcs, seg[i].ptr); - ASSERT(tcs, seg[i].size >= 1000); + ASSERT(tcs, seg[i].size >= (1 << 18)); } n = MSEG_NO(); diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index 02c6e19686..3197a4c137 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -54,7 +54,7 @@ end_per_group(_GroupName, Config) -> %% Verify that apply(M, F, A) is really tail recursive. apply_last(Config) when is_list(Config) -> - Pid=spawn(?MODULE, applied, [self(), 10000]), + Pid = spawn(?MODULE, applied, [self(), 10000]), Size = receive {Pid, finished} -> @@ -94,32 +94,32 @@ apply_last_bif(Config) when is_list(Config) -> %% Test three high register numbers in a put_list instruction %% (to test whether packing works properly). packed_registers(Config) when is_list(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Mod = packed_regs, - ?line Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), + PrivDir = ?config(priv_dir, Config), + Mod = packed_regs, + Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), %% Generate a module which generates a list of tuples. %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}]. - ?line Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", + Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", "-export([put_list/1]).\n", "put_list(A) ->\n["]), - ?line ok = file:write_file(Name, Code), + ok = file:write_file(Name, Code), %% Compile the module. - ?line io:format("Compiling: ~s\n", [Name]), - ?line CompRc = compile:file(Name, [{outdir, PrivDir}, report]), - ?line io:format("Result: ~p\n",[CompRc]), - ?line {ok, Mod} = CompRc, + io:format("Compiling: ~s\n", [Name]), + CompRc = compile:file(Name, [{outdir, PrivDir}, report]), + io:format("Result: ~p\n",[CompRc]), + {ok, Mod} = CompRc, %% Load it. - ?line io:format("Loading...\n",[]), - ?line LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), - ?line {module,_Module} = LoadRc, + io:format("Loading...\n",[]), + LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), + {module,_Module} = LoadRc, %% Call it and verify result. - ?line Term = {a, b}, - ?line L = Mod:put_list(Term), - ?line verify_packed_regs(L, Term, 600), + Term = {a, b}, + L = Mod:put_list(Term), + verify_packed_regs(L, Term, 600), ok. gen_packed_regs(0, Acc) -> @@ -131,11 +131,11 @@ verify_packed_regs([], _, -1) -> ok; verify_packed_regs([{Term, N}| T], Term, N) -> verify_packed_regs(T, Term, N-1); verify_packed_regs(L, Term, N) -> - ?line ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]), - ?line test_server:fail(). + ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]), + test_server:fail(). buildo_mucho(Config) when is_list(Config) -> - ?line buildo_mucho_1(), + buildo_mucho_1(), ok. buildo_mucho_1() -> @@ -206,20 +206,27 @@ buildo_mucho_1() -> {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}]. heap_sizes(Config) when is_list(Config) -> - ?line Sizes = erlang:system_info(heap_sizes), - ?line io:format("~p heap sizes\n", [length(Sizes)]), - ?line io:format("~p\n", [Sizes]), + Sizes = erlang:system_info(heap_sizes), + io:format("~p heap sizes\n", [length(Sizes)]), + io:format("~p\n", [Sizes]), %% Verify that heap sizes increase monotonically. - ?line Largest = lists:foldl(fun(E, P) when is_integer(P), E > P -> E; + Largest = lists:foldl(fun(E, P) when is_integer(P), E > P -> E; (E, []) -> E end, [], Sizes), - %% Verify that the largest heap size consists of 31 or 63 bits. - ?line - case Largest bsr (erlang:system_info(wordsize)*8-2) of - R when R > 0 -> ok - end, + %% Verify that the largest heap size consists of + %% - 31 bits of bytes on 32 bits arch + %% - atleast 52 bits of bytes (48 is the maximum virtual address) + %% and at the most 63 bits on 64 bit archs + %% heap sizes are in words + case erlang:system_info(wordsize) of + 8 -> + 0 = (Largest*8) bsr 63, + true = (Largest*8) > (1 bsl 52); + 4 -> + 1 = (Largest*4) bsr 31 + end, ok. %% Thanks to Igor Goryachev. @@ -302,10 +309,10 @@ b() -> end. fconv(Config) when is_list(Config) -> - ?line do_fconv(atom), - ?line do_fconv(nil), - ?line do_fconv(tuple_literal), - ?line 3.0 = do_fconv(1.0, 2.0), + do_fconv(atom), + do_fconv(nil), + do_fconv(tuple_literal), + 3.0 = do_fconv(1.0, 2.0), ok. do_fconv(Type) -> @@ -325,9 +332,9 @@ do_fconv(tuple_literal, Float) when is_float(Float) -> Float + {a,b}. select_val(Config) when is_list(Config) -> - ?line zero = do_select_val(0), - ?line big = do_select_val(1 bsl 64), - ?line integer = do_select_val(42), + zero = do_select_val(0), + big = do_select_val(1 bsl 64), + integer = do_select_val(42), ok. do_select_val(X) -> diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 461773114e..d5cb4ee1b7 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -28,7 +28,7 @@ unary_plus/1, unary_minus/1, moving_labels/1]). -export([fpe/1]). -export([otp_9422/1]). - +-export([faulty_seq_trace/1, do_faulty_seq_trace/0]). -export([runner/2, loop_runner/3]). -export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). -export([do_boxed_and_small/0]). @@ -59,6 +59,7 @@ all() -> ms_trace3, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, moving_labels, + faulty_seq_trace, otp_9422]; true -> [not_run] end. @@ -726,6 +727,19 @@ do_boxed_and_small() -> {ok, false, _, _} = erlang:match_spec_test({0,3},[{{make_ref(),'_'},[],['$_']}],table), ok. +faulty_seq_trace(doc) -> + ["Test that faulty seq_trace_call does not crash emulator"]; +faulty_seq_trace(suite) -> []; +faulty_seq_trace(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(match_spec_suite_other), + ?line ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]), + ?line stop_node(Node), + ok. + +do_faulty_seq_trace() -> + {ok,'EXIT',_,_} = erlang:match_spec_test([],[{'_',[],[{message,{set_seq_token,yxa,true}}]}],trace), + ok. + errchk(Pat) -> case catch erlang:trace_pattern({?MODULE, f2, 2}, Pat) of {'EXIT', {badarg, _}} -> diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 898535693f..11dd88413f 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -118,15 +118,15 @@ fun_spawn(Fun) -> %% (unclear if this test case will actually prove anything on %% a modern computer with lots of memory). spawn_with_binaries(Config) when is_list(Config) -> - ?line L = lists:duplicate(2048, 42), - ?line TwoMeg = lists:duplicate(1024, L), - ?line Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]), + L = lists:duplicate(2048, 42), + TwoMeg = lists:duplicate(1024, L), + Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]), receive after 1 -> ok end end, - ?line Iter = case test_server:purify_is_running() of + Iter = case test_server:purify_is_running() of true -> 10; false -> 150 end, - ?line test_server:do_times(Iter, Fun), + test_server:do_times(Iter, Fun), ok. binary_owner(Bin) when is_binary(Bin) -> @@ -134,87 +134,87 @@ binary_owner(Bin) when is_binary(Bin) -> %% Tests exit/1 with a big message. t_exit_1(Config) when is_list(Config) -> - ?line start_spawner(), - ?line Dog = test_server:timetrap(test_server:seconds(20)), - ?line process_flag(trap_exit, true), - ?line test_server:do_times(10, fun t_exit_1/0), - ?line test_server:timetrap_cancel(Dog), - ?line stop_spawner(), + start_spawner(), + Dog = test_server:timetrap(test_server:seconds(20)), + process_flag(trap_exit, true), + test_server:do_times(10, fun t_exit_1/0), + test_server:timetrap_cancel(Dog), + stop_spawner(), ok. t_exit_1() -> - ?line Pid = fun_spawn(fun() -> exit(kb_128()) end), - ?line Garbage = kb_128(), - ?line receive + Pid = fun_spawn(fun() -> exit(kb_128()) end), + Garbage = kb_128(), + receive {'EXIT', Pid, Garbage} -> ok end. %% Tests exit/2 with a lot of data in the exit message. t_exit_2_other(Config) when is_list(Config) -> - ?line start_spawner(), - ?line Dog = test_server:timetrap(test_server:seconds(20)), - ?line process_flag(trap_exit, true), - ?line test_server:do_times(10, fun t_exit_2_other/0), - ?line test_server:timetrap_cancel(Dog), - ?line stop_spawner(), + start_spawner(), + Dog = test_server:timetrap(test_server:seconds(20)), + process_flag(trap_exit, true), + test_server:do_times(10, fun t_exit_2_other/0), + test_server:timetrap_cancel(Dog), + stop_spawner(), ok. t_exit_2_other() -> - ?line Pid = fun_spawn(fun() -> receive x -> ok end end), - ?line Garbage = kb_128(), - ?line exit(Pid, Garbage), - ?line receive + Pid = fun_spawn(fun() -> receive x -> ok end end), + Garbage = kb_128(), + exit(Pid, Garbage), + receive {'EXIT', Pid, Garbage} -> ok end. %% Tests that exit(Pid, normal) does not kill another process.; t_exit_2_other_normal(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(20)), - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun() -> receive x -> ok end end), - ?line exit(Pid, normal), - ?line receive + Dog = test_server:timetrap(test_server:seconds(20)), + process_flag(trap_exit, true), + Pid = fun_spawn(fun() -> receive x -> ok end end), + exit(Pid, normal), + receive {'EXIT', Pid, Reason} -> - ?line test_server:fail({process_died, Reason}) + test_server:fail({process_died, Reason}) after 1000 -> ok end, - ?line case process_info(Pid) of + case process_info(Pid) of undefined -> test_server:fail(process_died_on_normal); List when is_list(List) -> ok end, exit(Pid, kill), - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. %% Tests that we can trap an exit message sent with exit/2 from %% the same process. self_exit(Config) when is_list(Config) -> - ?line start_spawner(), - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line test_server:do_times(200, fun self_exit/0), - ?line test_server:timetrap_cancel(Dog), - ?line stop_spawner(), + start_spawner(), + Dog = test_server:timetrap(test_server:seconds(10)), + process_flag(trap_exit, true), + test_server:do_times(200, fun self_exit/0), + test_server:timetrap_cancel(Dog), + stop_spawner(), ok. self_exit() -> - ?line Garbage = eight_kb(), - ?line P = self(), - ?line true = exit(P, Garbage), - ?line receive + Garbage = eight_kb(), + P = self(), + true = exit(P, Garbage), + receive {'EXIT', P, Garbage} -> ok end. %% Tests exit(self(), normal) is equivalent to exit(normal) for a process %% that doesn't trap exits. normal_suicide_exit(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun() -> exit(self(), normal) end), - ?line receive + process_flag(trap_exit, true), + Pid = fun_spawn(fun() -> exit(self(), normal) end), + receive {'EXIT', Pid, normal} -> ok; Other -> test_server:fail({bad_message, Other}) end. @@ -222,19 +222,19 @@ normal_suicide_exit(Config) when is_list(Config) -> %% Tests exit(self(), Term) is equivalent to exit(Term) for a process %% that doesn't trap exits."; abnormal_suicide_exit(Config) when is_list(Config) -> - ?line Garbage = eight_kb(), - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun() -> exit(self(), Garbage) end), - ?line receive + Garbage = eight_kb(), + process_flag(trap_exit, true), + Pid = fun_spawn(fun() -> exit(self(), Garbage) end), + receive {'EXIT', Pid, Garbage} -> ok; Other -> test_server:fail({bad_message, Other}) end. %% Tests that exit(self(), die) cannot be catched. t_exit_2_catch(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Pid = fun_spawn(fun() -> catch exit(self(), die) end), - ?line receive + process_flag(trap_exit, true), + Pid = fun_spawn(fun() -> catch exit(self(), die) end), + receive {'EXIT', Pid, normal} -> test_server:fail(catch_worked); {'EXIT', Pid, die} -> @@ -246,29 +246,29 @@ t_exit_2_catch(Config) when is_list(Config) -> %% Tests trapping of an 'EXIT' message generated by a bad argument to %% the abs/1 bif. The 'EXIT' message will intentionally be very big. trap_exit_badarg(Config) when is_list(Config) -> - ?line start_spawner(), - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line test_server:do_times(10, fun trap_exit_badarg/0), - ?line test_server:timetrap_cancel(Dog), - ?line stop_spawner(), + start_spawner(), + Dog = test_server:timetrap(test_server:seconds(10)), + process_flag(trap_exit, true), + test_server:do_times(10, fun trap_exit_badarg/0), + test_server:timetrap_cancel(Dog), + stop_spawner(), ok. trap_exit_badarg() -> - ?line Pid = fun_spawn(fun() -> bad_guy(kb_128()) end), - ?line Garbage = kb_128(), - ?line receive + Pid = fun_spawn(fun() -> bad_guy(kb_128()) end), + Garbage = kb_128(), + receive {'EXIT',Pid,{badarg,[{erlang,abs,[Garbage],Loc1}, {?MODULE,bad_guy,1,Loc2}|_]}} when is_list(Loc1), is_list(Loc2) -> ok; Other -> - ?line ok = io:format("Bad EXIT message: ~P", [Other, 30]), - ?line test_server:fail(bad_exit_message) + ok = io:format("Bad EXIT message: ~P", [Other, 30]), + test_server:fail(bad_exit_message) end. bad_guy(Arg) -> - ?line abs(Arg). + abs(Arg). kb_128() -> @@ -281,11 +281,11 @@ kb_128() -> eight_kb() -> B64 = lists:seq(1, 64), - ?line B512 = {<<1>>,B64,<<2,3>>,B64,make_unaligned_sub_binary(<<4,5,6,7,8,9>>), + B512 = {<<1>>,B64,<<2,3>>,B64,make_unaligned_sub_binary(<<4,5,6,7,8,9>>), B64,make_sub_binary([1,2,3,4,5,6]), B64,make_sub_binary(lists:seq(1, ?heap_binary_size+1)), B64,B64,B64,B64,big_binary()}, - ?line lists:duplicate(8, {B512,B512}). + lists:duplicate(8, {B512,B512}). big_binary() -> big_binary(10, [42]). @@ -296,19 +296,19 @@ big_binary(N, Acc) -> %% Test receiving an EXIT message when spawning a BIF with bad arguments. trap_exit_badarg_in_bif(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(10)), - ?line process_flag(trap_exit, true), - ?line test_server:do_times(10, fun trap_exit_badarg_bif/0), - ?line test_server:timetrap_cancel(Dog), + Dog = test_server:timetrap(test_server:seconds(10)), + process_flag(trap_exit, true), + test_server:do_times(10, fun trap_exit_badarg_bif/0), + test_server:timetrap_cancel(Dog), ok. trap_exit_badarg_bif() -> - ?line Pid = spawn_link(erlang, node, [1]), - ?line receive + Pid = spawn_link(erlang, node, [1]), + receive {'EXIT', Pid, {badarg, _}} -> ok; Other -> - ?line test_server:fail({unexpected, Other}) + test_server:fail({unexpected, Other}) end. %% The following sequences of events have crasched Beam. @@ -321,27 +321,27 @@ trap_exit_badarg_bif() -> %% 3) The process will crash the next time it executes 'receive'. exit_and_timeout(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(20)), + Dog = test_server:timetrap(test_server:seconds(20)), - ?line process_flag(trap_exit, true), - ?line Parent = self(), - ?line Low = fun_spawn(fun() -> eat_low(Parent) end), - ?line High = fun_spawn(fun() -> eat_high(Low) end), - ?line eat_wait_for(Low, High), + process_flag(trap_exit, true), + Parent = self(), + Low = fun_spawn(fun() -> eat_low(Parent) end), + High = fun_spawn(fun() -> eat_high(Low) end), + eat_wait_for(Low, High), - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. eat_wait_for(Low, High) -> - ?line receive - {'EXIT', Low, {you, are, dead}} -> - ok; - {'EXIT', High, normal} -> - eat_wait_for(Low, High); - Other -> - test_server:fail({bad_message, Other}) - end. + receive + {'EXIT', Low, {you, are, dead}} -> + ok; + {'EXIT', High, normal} -> + eat_wait_for(Low, High); + Other -> + test_server:fail({bad_message, Other}) + end. eat_low(_Parent) -> receive @@ -374,27 +374,27 @@ loop(_, _) -> %% Tries to send two different exit messages to a process. %% (The second one should be ignored.) exit_twice(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:seconds(20)), + Dog = test_server:timetrap(test_server:seconds(20)), - ?line process_flag(trap_exit, true), - ?line Low = fun_spawn(fun etwice_low/0), - ?line High = fun_spawn(fun() -> etwice_high(Low) end), - ?line etwice_wait_for(Low, High), + process_flag(trap_exit, true), + Low = fun_spawn(fun etwice_low/0), + High = fun_spawn(fun() -> etwice_high(Low) end), + etwice_wait_for(Low, High), - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. etwice_wait_for(Low, High) -> - ?line receive - {'EXIT', Low, first} -> - ok; - {'EXIT', Low, Other} -> - test_server:fail({wrong_exit_reason, Other}); - {'EXIT', High, normal} -> - etwice_wait_for(Low, High); - Other -> - test_server:fail({bad_message, Other}) - end. + receive + {'EXIT', Low, first} -> + ok; + {'EXIT', Low, Other} -> + test_server:fail({wrong_exit_reason, Other}); + {'EXIT', High, normal} -> + etwice_wait_for(Low, High); + Other -> + test_server:fail({bad_message, Other}) + end. etwice_low() -> etwice_low(). @@ -406,15 +406,15 @@ etwice_high(Low) -> %% Tests the process_info/2 BIF. t_process_info(Config) when is_list(Config) -> - ?line [] = process_info(self(), registered_name), - ?line register(my_name, self()), - ?line {registered_name, my_name} = process_info(self(), registered_name), - ?line {status, running} = process_info(self(), status), - ?line {min_heap_size, 233} = process_info(self(), min_heap_size), - ?line {min_bin_vheap_size, 46368} = process_info(self(), min_bin_vheap_size), - ?line {current_function,{?MODULE,t_process_info,1}} = + [] = process_info(self(), registered_name), + register(my_name, self()), + {registered_name, my_name} = process_info(self(), registered_name), + {status, running} = process_info(self(), status), + {min_heap_size, 233} = process_info(self(), min_heap_size), + {min_bin_vheap_size,46422} = process_info(self(), min_bin_vheap_size), + {current_function,{?MODULE,t_process_info,1}} = process_info(self(), current_function), - ?line {current_function,{?MODULE,t_process_info,1}} = + {current_function,{?MODULE,t_process_info,1}} = apply(erlang, process_info, [self(),current_function]), %% current_location and current_stacktrace @@ -425,9 +425,9 @@ t_process_info(Config) when is_list(Config) -> verify_loc(Line2, Res2), pi_stacktrace([{?MODULE,t_process_info,1,?LINE}]), - ?line Gleader = group_leader(), - ?line {group_leader, Gleader} = process_info(self(), group_leader), - ?line {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), + Gleader = group_leader(), + {group_leader, Gleader} = process_info(self(), group_leader), + {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), ok. pi_stacktrace(Expected0) -> @@ -509,50 +509,50 @@ process_info_looper(Parent) -> %% Tests the process_info/1 BIF on another process with messages. process_info_other_msg(Config) when is_list(Config) -> Self = self(), - ?line Pid = spawn_link(fun() -> other_process(Self) end), + Pid = spawn_link(fun() -> other_process(Self) end), receive {go_ahead,Pid} -> ok end, - ?line Own = {my,own,message}, + Own = {my,own,message}, - ?line {messages,[Own]} = process_info(Pid, messages), + {messages,[Own]} = process_info(Pid, messages), - ?line Garbage = kb_128(), - ?line MsgA = {a,Garbage}, - ?line MsgB = {b,Garbage}, - ?line MsgC = {c,Garbage}, - ?line MsgD = {d,Garbage}, - ?line MsgE = {e,Garbage}, - - ?line Pid ! MsgA, - ?line {messages,[Own,MsgA]} = process_info(Pid, messages), - ?line Pid ! MsgB, - ?line {messages,[Own,MsgA,MsgB]} = process_info(Pid, messages), - ?line Pid ! MsgC, - ?line {messages,[Own,MsgA,MsgB,MsgC]} = process_info(Pid, messages), - ?line Pid ! MsgD, - ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD]} = process_info(Pid, messages), - ?line Pid ! MsgE, - ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} = process_info(Pid, messages), - ?line {memory,BytesOther} = process_info(Pid, memory), - ?line {memory,BytesSelf} = process_info(self(), memory), + Garbage = kb_128(), + MsgA = {a,Garbage}, + MsgB = {b,Garbage}, + MsgC = {c,Garbage}, + MsgD = {d,Garbage}, + MsgE = {e,Garbage}, + + Pid ! MsgA, + {messages,[Own,MsgA]} = process_info(Pid, messages), + Pid ! MsgB, + {messages,[Own,MsgA,MsgB]} = process_info(Pid, messages), + Pid ! MsgC, + {messages,[Own,MsgA,MsgB,MsgC]} = process_info(Pid, messages), + Pid ! MsgD, + {messages,[Own,MsgA,MsgB,MsgC,MsgD]} = process_info(Pid, messages), + Pid ! MsgE, + {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} = process_info(Pid, messages), + {memory,BytesOther} = process_info(Pid, memory), + {memory,BytesSelf} = process_info(self(), memory), io:format("Memory ~p: ~p\n", [Pid,BytesOther]), io:format("Memory ~p (self): ~p\n", [self(),BytesSelf]), [Own,MsgA,MsgB,MsgC,MsgD,MsgE] = All, - ?line Pid ! {self(),empty}, - ?line receive + Pid ! {self(),empty}, + receive empty -> ok end, - ?line {messages,[]} = process_info(Pid, messages), + {messages,[]} = process_info(Pid, messages), - ?line {min_heap_size, 233} = process_info(Pid, min_heap_size), - ?line {min_bin_vheap_size, 46368} = process_info(Pid, min_bin_vheap_size), + {min_heap_size, 233} = process_info(Pid, min_heap_size), + {min_bin_vheap_size, 46422} = process_info(Pid, min_bin_vheap_size), - ?line Pid ! stop, + Pid ! stop, ok. process_info_other_dist_msg(Config) when is_list(Config) -> @@ -560,52 +560,51 @@ process_info_other_dist_msg(Config) when is_list(Config) -> %% Check that process_info can handle messages that have not been %% decoded yet. %% - ?line {ok, Node} = start_node(Config), - ?line Self = self(), - ?line Pid = spawn_link(fun() -> other_process(Self) end), - ?line receive {go_ahead,Pid} -> ok end, + {ok, Node} = start_node(Config), + Self = self(), + Pid = spawn_link(fun() -> other_process(Self) end), + receive {go_ahead,Pid} -> ok end, - ?line Own = {my,own,message}, + Own = {my,own,message}, - ?line {messages,[Own]} = process_info(Pid, messages), - ?line Garbage = kb_128(), - ?line MsgA = {a,self(),Garbage}, - ?line MsgB = {b,self(),Garbage}, - ?line MsgC = {c,self(),Garbage}, - ?line MsgD = {d,self(),Garbage}, - ?line MsgE = {e,self(),Garbage}, + {messages,[Own]} = process_info(Pid, messages), + Garbage = kb_128(), + MsgA = {a,self(),Garbage}, + MsgB = {b,self(),Garbage}, + MsgC = {c,self(),Garbage}, + MsgD = {d,self(),Garbage}, + MsgE = {e,self(),Garbage}, %% We don't want the other process to decode messages itself %% therefore we suspend it. - ?line true = erlang:suspend_process(Pid), - ?line spawn_link(Node, fun () -> - Pid ! MsgA, - Pid ! MsgB, - Pid ! MsgC, - Self ! check_abc - end), - ?line receive check_abc -> ok end, - ?line [{status,suspended}, - {messages,[Own,MsgA,MsgB,MsgC]}, - {status,suspended}]= process_info(Pid, [status,messages,status]), - ?line spawn_link(Node, fun () -> - Pid ! MsgD, - Pid ! MsgE, - Self ! check_de - end), - ?line receive check_de -> ok end, - ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} - = process_info(Pid, messages), - ?line true = erlang:resume_process(Pid), - ?line Pid ! {self(), get_all_messages}, - ?line receive + true = erlang:suspend_process(Pid), + spawn_link(Node, fun () -> + Pid ! MsgA, + Pid ! MsgB, + Pid ! MsgC, + Self ! check_abc + end), + receive check_abc -> ok end, + [{status,suspended}, + {messages,[Own,MsgA,MsgB,MsgC]}, + {status,suspended}]= process_info(Pid, [status,messages,status]), + spawn_link(Node, fun () -> + Pid ! MsgD, + Pid ! MsgE, + Self ! check_de + end), + receive check_de -> ok end, + {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} = process_info(Pid, messages), + true = erlang:resume_process(Pid), + Pid ! {self(), get_all_messages}, + receive {all_messages, AllMsgs} -> - ?line All = AllMsgs + All = AllMsgs end, - ?line {messages,[]} = process_info(Pid, messages), - ?line Pid ! stop, - ?line stop_node(Node), - ?line ok. + {messages,[]} = process_info(Pid, messages), + Pid ! stop, + stop_node(Node), + ok. other_process(Parent) -> @@ -652,38 +651,36 @@ process_info_2_list(doc) -> process_info_2_list(suite) -> []; process_info_2_list(Config) when is_list(Config) -> - ?line Proc = spawn(fun () -> - receive after infinity -> ok end end), + Proc = spawn(fun () -> receive after infinity -> ok end end), register(process_SUITE_process_info_2_list1, self()), register(process_SUITE_process_info_2_list2, Proc), - ?line erts_debug:set_internal_state(available_internal_state,true), - ?line AllArgs = erts_debug:get_internal_state(process_info_args), - ?line A1 = lists:sort(AllArgs) ++ [status] ++ lists:reverse(AllArgs), + erts_debug:set_internal_state(available_internal_state,true), + AllArgs = erts_debug:get_internal_state(process_info_args), + A1 = lists:sort(AllArgs) ++ [status] ++ lists:reverse(AllArgs), %% Verify that argument is accepted as single atom - ?line lists:foreach(fun (A) -> - ?line {A, _} = process_info(Proc, A), - ?line {A, _} = process_info(self(), A) - end, - A1), + lists:foreach(fun (A) -> + {A, _} = process_info(Proc, A), + {A, _} = process_info(self(), A) + end, A1), %% Verify that order is preserved - ?line ok = chk_pi_order(process_info(self(), A1), A1), - ?line ok = chk_pi_order(process_info(Proc, A1), A1), + ok = chk_pi_order(process_info(self(), A1), A1), + ok = chk_pi_order(process_info(Proc, A1), A1), %% Small arg list - ?line A2 = [status, stack_size, trap_exit, priority], - ?line [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] + A2 = [status, stack_size, trap_exit, priority], + [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] = process_info(Proc, A2), - ?line [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] + [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] = process_info(self(), A2), %% Huge arg list (note values are shared) - ?line A3 = lists:duplicate(5000,backtrace), - ?line V3 = process_info(Proc, A3), - ?line 5000 = length(V3), - ?line lists:foreach(fun ({backtrace, _}) -> ok end, V3), - ?line ok. + A3 = lists:duplicate(5000,backtrace), + V3 = process_info(Proc, A3), + 5000 = length(V3), + lists:foreach(fun ({backtrace, _}) -> ok end, V3), + ok. process_info_lock_reschedule(doc) -> []; @@ -692,43 +689,37 @@ process_info_lock_reschedule(suite) -> process_info_lock_reschedule(Config) when is_list(Config) -> %% We need a process that is running and an item that requires %% process_info to take the main process lock. - ?line Target1 = spawn_link(fun tok_loop/0), - ?line Name1 = process_info_lock_reschedule_running, - ?line register(Name1, Target1), - ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end), - ?line Name2 = process_info_lock_reschedule_waiting, - ?line register(Name2, Target2), - ?line PI = fun(_) -> - ?line erlang:yield(), - ?line [{registered_name, Name1}] - = process_info(Target1, [registered_name]), - ?line [{registered_name, Name2}] - = process_info(Target2, [registered_name]), - ?line erlang:yield(), - ?line {registered_name, Name1} - = process_info(Target1, registered_name), - ?line {registered_name, Name2} - = process_info(Target2, registered_name), - ?line erlang:yield(), - ?line [{registered_name, Name1}| _] - = process_info(Target1), - ?line [{registered_name, Name2}| _] - = process_info(Target2) - end, - ?line lists:foreach(PI, lists:seq(1,1000)), + Target1 = spawn_link(fun tok_loop/0), + Name1 = process_info_lock_reschedule_running, + register(Name1, Target1), + Target2 = spawn_link(fun () -> receive after infinity -> ok end end), + Name2 = process_info_lock_reschedule_waiting, + register(Name2, Target2), + PI = fun(_) -> + erlang:yield(), + [{registered_name, Name1}] = process_info(Target1, [registered_name]), + [{registered_name, Name2}] = process_info(Target2, [registered_name]), + erlang:yield(), + {registered_name, Name1} = process_info(Target1, registered_name), + {registered_name, Name2} = process_info(Target2, registered_name), + erlang:yield(), + [{registered_name, Name1}| _] = process_info(Target1), + [{registered_name, Name2}| _] = process_info(Target2) + end, + lists:foreach(PI, lists:seq(1,1000)), %% Make sure Target1 still is willing to "tok loop" - ?line case process_info(Target1, status) of - {status, OkStatus} when OkStatus == runnable; - OkStatus == running; - OkStatus == garbage_collecting -> - ?line unlink(Target1), - ?line unlink(Target2), - ?line exit(Target1, bang), - ?line exit(Target2, bang), - ?line OkStatus; - {status, BadStatus} -> - ?line ?t:fail(BadStatus) - end. + case process_info(Target1, status) of + {status, OkStatus} when OkStatus == runnable; + OkStatus == running; + OkStatus == garbage_collecting -> + unlink(Target1), + unlink(Target2), + exit(Target1, bang), + exit(Target2, bang), + OkStatus; + {status, BadStatus} -> + ?t:fail(BadStatus) + end. pi_loop(_Name, _Pid, 0) -> ok; @@ -741,50 +732,50 @@ process_info_lock_reschedule2(doc) -> process_info_lock_reschedule2(suite) -> []; process_info_lock_reschedule2(Config) when is_list(Config) -> - ?line Parent = self(), - ?line Fun = fun () -> - receive {go, Name, Pid} -> ok end, - pi_loop(Name, Pid, 10000), - Parent ! {done, self()}, - receive after infinity -> ok end - end, - ?line P1 = spawn_link(Fun), - ?line N1 = process_info_lock_reschedule2_1, - ?line true = register(N1, P1), - ?line P2 = spawn_link(Fun), - ?line N2 = process_info_lock_reschedule2_2, - ?line true = register(N2, P2), - ?line P3 = spawn_link(Fun), - ?line N3 = process_info_lock_reschedule2_3, - ?line true = register(N3, P3), - ?line P4 = spawn_link(Fun), - ?line N4 = process_info_lock_reschedule2_4, - ?line true = register(N4, P4), - ?line P5 = spawn_link(Fun), - ?line N5 = process_info_lock_reschedule2_5, - ?line true = register(N5, P5), - ?line P6 = spawn_link(Fun), - ?line N6 = process_info_lock_reschedule2_6, - ?line true = register(N6, P6), - ?line P1 ! {go, N2, P2}, - ?line P2 ! {go, N1, P1}, - ?line P3 ! {go, N1, P1}, - ?line P4 ! {go, N1, P1}, - ?line P5 ! {go, N6, P6}, - ?line P6 ! {go, N5, P5}, - ?line receive {done, P1} -> ok end, - ?line receive {done, P2} -> ok end, - ?line receive {done, P3} -> ok end, - ?line receive {done, P4} -> ok end, - ?line receive {done, P5} -> ok end, - ?line receive {done, P6} -> ok end, - ?line unlink(P1), exit(P1, bang), - ?line unlink(P2), exit(P2, bang), - ?line unlink(P3), exit(P3, bang), - ?line unlink(P4), exit(P4, bang), - ?line unlink(P5), exit(P5, bang), - ?line unlink(P6), exit(P6, bang), - ?line ok. + Parent = self(), + Fun = fun () -> + receive {go, Name, Pid} -> ok end, + pi_loop(Name, Pid, 10000), + Parent ! {done, self()}, + receive after infinity -> ok end + end, + P1 = spawn_link(Fun), + N1 = process_info_lock_reschedule2_1, + true = register(N1, P1), + P2 = spawn_link(Fun), + N2 = process_info_lock_reschedule2_2, + true = register(N2, P2), + P3 = spawn_link(Fun), + N3 = process_info_lock_reschedule2_3, + true = register(N3, P3), + P4 = spawn_link(Fun), + N4 = process_info_lock_reschedule2_4, + true = register(N4, P4), + P5 = spawn_link(Fun), + N5 = process_info_lock_reschedule2_5, + true = register(N5, P5), + P6 = spawn_link(Fun), + N6 = process_info_lock_reschedule2_6, + true = register(N6, P6), + P1 ! {go, N2, P2}, + P2 ! {go, N1, P1}, + P3 ! {go, N1, P1}, + P4 ! {go, N1, P1}, + P5 ! {go, N6, P6}, + P6 ! {go, N5, P5}, + receive {done, P1} -> ok end, + receive {done, P2} -> ok end, + receive {done, P3} -> ok end, + receive {done, P4} -> ok end, + receive {done, P5} -> ok end, + receive {done, P6} -> ok end, + unlink(P1), exit(P1, bang), + unlink(P2), exit(P2, bang), + unlink(P3), exit(P3, bang), + unlink(P4), exit(P4, bang), + unlink(P5), exit(P5, bang), + unlink(P6), exit(P6, bang), + ok. many_args(0,_B,_C,_D,_E,_F,_G,_H,_I,_J) -> ok; @@ -802,120 +793,115 @@ process_info_lock_reschedule3(suite) -> process_info_lock_reschedule3(Config) when is_list(Config) -> %% We need a process that is running and an item that requires %% process_info to take the main process lock. - ?line Target1 = spawn_link(fun tok_loop/0), - ?line Name1 = process_info_lock_reschedule_running, - ?line register(Name1, Target1), - ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end), - ?line Name2 = process_info_lock_reschedule_waiting, - ?line register(Name2, Target2), - ?line PI = fun(N) -> - case N rem 10 of - 0 -> erlang:yield(); - _ -> ok - end, - ?line do_pi_msg_len({proc, Target1}, - {arg, message_queue_len}) - end, - ?line many_args(100000,1,2,3,4,5,6,7,8,9), - ?line lists:foreach(PI, lists:seq(1,1000000)), + Target1 = spawn_link(fun tok_loop/0), + Name1 = process_info_lock_reschedule_running, + register(Name1, Target1), + Target2 = spawn_link(fun () -> receive after infinity -> ok end end), + Name2 = process_info_lock_reschedule_waiting, + register(Name2, Target2), + PI = fun(N) -> + case N rem 10 of + 0 -> erlang:yield(); + _ -> ok + end, + do_pi_msg_len({proc, Target1}, + {arg, message_queue_len}) + end, + many_args(100000,1,2,3,4,5,6,7,8,9), + lists:foreach(PI, lists:seq(1,1000000)), %% Make sure Target1 still is willing to "tok loop" - ?line case process_info(Target1, status) of + case process_info(Target1, status) of {status, OkStatus} when OkStatus == runnable; OkStatus == running; OkStatus == garbage_collecting -> - ?line unlink(Target1), - ?line unlink(Target2), - ?line exit(Target1, bang), - ?line exit(Target2, bang), - ?line OkStatus; + unlink(Target1), + unlink(Target2), + exit(Target1, bang), + exit(Target2, bang), + OkStatus; {status, BadStatus} -> - ?line ?t:fail(BadStatus) + ?t:fail(BadStatus) end. process_status_exiting(Config) when is_list(Config) -> %% Make sure that erts_debug:get_internal_state({process_status,P}) %% returns exiting if it is in status P_EXITING. - ?line erts_debug:set_internal_state(available_internal_state,true), - ?line Prio = process_flag(priority, max), - ?line P = spawn_opt(fun () -> receive after infinity -> ok end end, + erts_debug:set_internal_state(available_internal_state,true), + Prio = process_flag(priority, max), + P = spawn_opt(fun () -> receive after infinity -> ok end end, [{priority, normal}]), - ?line erlang:yield(), + erlang:yield(), %% The tok_loop processes are here to make it hard for the exiting %% process to be scheduled in for exit... - ?line TokLoops = lists:map(fun (_) -> - spawn_opt(fun tok_loop/0, - [link,{priority, high}]) - end, - lists:seq(1, erlang:system_info(schedulers_online))), - ?line exit(P, boom), - ?line wait_until( - fun () -> - exiting =:= erts_debug:get_internal_state({process_status,P}) - end), - ?line lists:foreach(fun (Tok) -> unlink(Tok), exit(Tok,bang) end, TokLoops), - ?line process_flag(priority, Prio), - ?line ok. + TokLoops = lists:map(fun (_) -> + spawn_opt(fun tok_loop/0, + [link,{priority, high}]) + end, lists:seq(1, erlang:system_info(schedulers_online))), + exit(P, boom), + wait_until(fun() -> + exiting =:= erts_debug:get_internal_state({process_status,P}) + end), + lists:foreach(fun (Tok) -> unlink(Tok), exit(Tok,bang) end, TokLoops), + process_flag(priority, Prio), + ok. otp_4725(Config) when is_list(Config) -> - ?line Tester = self(), - ?line Ref1 = make_ref(), - ?line Pid1 = spawn_opt(fun () -> - Tester ! {Ref1, process_info(self())}, - receive - Ref1 -> bye - end - end, - [link, - {priority, max}, - {fullsweep_after, 600}]), - ?line receive - {Ref1, ProcInfo1A} -> - ?line ProcInfo1B = process_info(Pid1), - ?line Pid1 ! Ref1, - ?line check_proc_infos(ProcInfo1A, ProcInfo1B) - end, - ?line Ref2 = make_ref(), - ?line Pid2 = spawn_opt(fun () -> - Tester ! {Ref2, process_info(self())}, - receive - Ref2 -> bye - end - end, - []), - ?line receive - {Ref2, ProcInfo2A} -> - ?line ProcInfo2B = process_info(Pid2), - ?line Pid2 ! Ref2, - ?line check_proc_infos(ProcInfo2A, ProcInfo2B) - end, - ?line ok. + Tester = self(), + Ref1 = make_ref(), + Pid1 = spawn_opt(fun () -> + Tester ! {Ref1, process_info(self())}, + receive + Ref1 -> bye + end + end, [link, {priority, max}, {fullsweep_after, 600}]), + receive + {Ref1, ProcInfo1A} -> + ProcInfo1B = process_info(Pid1), + Pid1 ! Ref1, + check_proc_infos(ProcInfo1A, ProcInfo1B) + end, + Ref2 = make_ref(), + Pid2 = spawn_opt(fun () -> + Tester ! {Ref2, process_info(self())}, + receive + Ref2 -> bye + end + end, + []), + receive + {Ref2, ProcInfo2A} -> + ProcInfo2B = process_info(Pid2), + Pid2 ! Ref2, + check_proc_infos(ProcInfo2A, ProcInfo2B) + end, + ok. check_proc_infos(A, B) -> - ?line IC = lists:keysearch(initial_call, 1, A), - ?line IC = lists:keysearch(initial_call, 1, B), + IC = lists:keysearch(initial_call, 1, A), + IC = lists:keysearch(initial_call, 1, B), - ?line L = lists:keysearch(links, 1, A), - ?line L = lists:keysearch(links, 1, B), + L = lists:keysearch(links, 1, A), + L = lists:keysearch(links, 1, B), - ?line D = lists:keysearch(dictionary, 1, A), - ?line D = lists:keysearch(dictionary, 1, B), + D = lists:keysearch(dictionary, 1, A), + D = lists:keysearch(dictionary, 1, B), - ?line TE = lists:keysearch(trap_exit, 1, A), - ?line TE = lists:keysearch(trap_exit, 1, B), + TE = lists:keysearch(trap_exit, 1, A), + TE = lists:keysearch(trap_exit, 1, B), - ?line EH = lists:keysearch(error_handler, 1, A), - ?line EH = lists:keysearch(error_handler, 1, B), + EH = lists:keysearch(error_handler, 1, A), + EH = lists:keysearch(error_handler, 1, B), - ?line P = lists:keysearch(priority, 1, A), - ?line P = lists:keysearch(priority, 1, B), + P = lists:keysearch(priority, 1, A), + P = lists:keysearch(priority, 1, B), - ?line GL = lists:keysearch(group_leader, 1, A), - ?line GL = lists:keysearch(group_leader, 1, B), + GL = lists:keysearch(group_leader, 1, A), + GL = lists:keysearch(group_leader, 1, B), - ?line GC = lists:keysearch(garbage_collection, 1, A), - ?line GC = lists:keysearch(garbage_collection, 1, B), + GC = lists:keysearch(garbage_collection, 1, A), + GC = lists:keysearch(garbage_collection, 1, B), - ?line ok. + ok. %% Dummies. @@ -928,18 +914,18 @@ stop_spawner() -> %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> - ?line erlang:garbage_collect(), - ?line receive after 1 -> ok end, % Clear reductions. - ?line {reductions,R1} = process_info(self(), reductions), - ?line true = erlang:bump_reductions(100), - ?line {reductions,R2} = process_info(self(), reductions), - ?line case R2-R1 of + erlang:garbage_collect(), + receive after 1 -> ok end, % Clear reductions. + {reductions,R1} = process_info(self(), reductions), + true = erlang:bump_reductions(100), + {reductions,R2} = process_info(self(), reductions), + case R2-R1 of Diff when Diff < 100 -> - ?line ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), - ?line test_server:fail({small_diff, Diff}); + ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), + test_server:fail({small_diff, Diff}); Diff when Diff > 110 -> - ?line ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), - ?line test_server:fail({big_diff, Diff}); + ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), + test_server:fail({big_diff, Diff}); Diff -> io:format("~p\n", [Diff]), ok @@ -949,11 +935,11 @@ bump_reductions(Config) when is_list(Config) -> bump_big(R2, 16#08000000). bump_big(Prev, Limit) -> - ?line true = erlang:bump_reductions(100000), %Limited to CONTEXT_REDUCTIONS. - ?line case process_info(self(), reductions) of + true = erlang:bump_reductions(100000), %Limited to CONTEXT_REDUCTIONS. + case process_info(self(), reductions) of {reductions,Big} when is_integer(Big), Big > Limit -> - ?line erlang:garbage_collect(), - ?line io:format("~p\n", [Big]); + erlang:garbage_collect(), + io:format("~p\n", [Big]); {reductions,R} when is_integer(R), R > Prev -> bump_big(R, Limit) end, @@ -964,34 +950,34 @@ bump_big(Prev, Limit) -> low_prio(Config) when is_list(Config) -> case erlang:system_info(schedulers_online) of 1 -> - ?line ok = low_prio_test(Config); + ok = low_prio_test(Config); _ -> - ?line erlang:system_flag(multi_scheduling, block), - ?line ok = low_prio_test(Config), - ?line erlang:system_flag(multi_scheduling, unblock), - ?line {comment, + erlang:system_flag(multi_scheduling, block), + ok = low_prio_test(Config), + erlang:system_flag(multi_scheduling, unblock), + {comment, "Test not written for SMP runtime system. " "Multi scheduling blocked during test."} end. low_prio_test(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line S = spawn_link(?MODULE, prio_server, [0, 0]), - ?line PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), - ?line timer:sleep(2000), - ?line lists:foreach(fun (P) -> exit(P, kill) end, PCs), - ?line S ! exit, - ?line receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, + process_flag(trap_exit, true), + S = spawn_link(?MODULE, prio_server, [0, 0]), + PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), + timer:sleep(2000), + lists:foreach(fun (P) -> exit(P, kill) end, PCs), + S ! exit, + receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, ok. check_prio(A, B) -> - ?line Prop = A/B, - ?line ok = io:format("Low=~p, High=~p, Prop=~p\n", [A, B, Prop]), + Prop = A/B, + ok = io:format("Low=~p, High=~p, Prop=~p\n", [A, B, Prop]), %% It isn't 1/8, it's more like 0.3, but let's check that %% the low-prio processes get some little chance to run at all. - ?line true = (Prop < 1.0), - ?line true = (Prop > 1/32). + true = (Prop < 1.0), + true = (Prop > 1/32). prio_server(A, B) -> receive @@ -1051,25 +1037,25 @@ yield(Config) when is_list(Config) -> end. yield_test() -> - ?line erlang:garbage_collect(), - ?line receive after 1 -> ok end, % Clear reductions. - ?line SC = schedcnt(start), - ?line {reductions, R1} = process_info(self(), reductions), - ?line {ok, true} = call_yield(middle), - ?line true = call_yield(final), - ?line true = call_yield(), - ?line true = apply(erlang, yield, []), - ?line {reductions, R2} = process_info(self(), reductions), - ?line Schedcnt = schedcnt(stop, SC), - ?line case {R2-R1, Schedcnt} of - {Diff, 4} when Diff < 30 -> - ?line ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", - [R1, R2, Schedcnt]); - {Diff, _} -> - ?line ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", - [R1, R2, Schedcnt]), - ?line test_server:fail({measurement_error, Diff, Schedcnt}) - end. + erlang:garbage_collect(), + receive after 1 -> ok end, % Clear reductions. + SC = schedcnt(start), + {reductions, R1} = process_info(self(), reductions), + {ok, true} = call_yield(middle), + true = call_yield(final), + true = call_yield(), + true = apply(erlang, yield, []), + {reductions, R2} = process_info(self(), reductions), + Schedcnt = schedcnt(stop, SC), + case {R2-R1, Schedcnt} of + {Diff, 4} when Diff < 30 -> + ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", + [R1, R2, Schedcnt]); + {Diff, _} -> + ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", + [R1, R2, Schedcnt]), + test_server:fail({measurement_error, Diff, Schedcnt}) + end. call_yield() -> erlang:yield(). @@ -1108,61 +1094,61 @@ schedcnt(stop, {Ref, Pid}) when is_reference(Ref), is_pid(Pid) -> yield2(doc) -> []; yield2(suite) -> []; yield2(Config) when is_list(Config) -> - ?line Me = self(), - ?line Go = make_ref(), - ?line RedDiff = make_ref(), - ?line Done = make_ref(), - ?line P = spawn(fun () -> - receive Go -> ok end, - {reductions, R1} = process_info(self(), reductions), - {ok, true} = call_yield(middle), - true = call_yield(final), - true = call_yield(), - true = apply(erlang, yield, []), - {reductions, R2} = process_info(self(), reductions), - Me ! {RedDiff, R2 - R1}, - exit(Done) - end), - ?line erlang:yield(), - - ?line 1 = erlang:trace(P, true, [running, procs, {tracer, self()}]), - - ?line P ! Go, + Me = self(), + Go = make_ref(), + RedDiff = make_ref(), + Done = make_ref(), + P = spawn(fun () -> + receive Go -> ok end, + {reductions, R1} = process_info(self(), reductions), + {ok, true} = call_yield(middle), + true = call_yield(final), + true = call_yield(), + true = apply(erlang, yield, []), + {reductions, R2} = process_info(self(), reductions), + Me ! {RedDiff, R2 - R1}, + exit(Done) + end), + erlang:yield(), + + 1 = erlang:trace(P, true, [running, procs, {tracer, self()}]), + + P ! Go, %% receive Go -> ok end, - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% {ok, true} = call_yield(middle), - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% true = call_yield(final), - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% true = call_yield(), - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% true = apply(erlang, yield, []), - ?line {trace, P, out, _} = next_tmsg(P), - ?line {trace, P, in, _} = next_tmsg(P), + {trace, P, out, _} = next_tmsg(P), + {trace, P, in, _} = next_tmsg(P), %% exit(Done) - ?line {trace, P, exit, Done} = next_tmsg(P), + {trace, P, exit, Done} = next_tmsg(P), - ?line receive + receive {RedDiff, Reductions} when Reductions < 30, Reductions > 0 -> io:format("Reductions = ~p~n", [Reductions]), - ?line ok; + ok; {RedDiff, Reductions} -> - ?line ?t:fail({unexpected_reduction_count, Reductions}) + ?t:fail({unexpected_reduction_count, Reductions}) end, - ?line none = next_tmsg(P), + none = next_tmsg(P), - ?line ok. + ok. next_tmsg(Pid) -> receive @@ -1178,19 +1164,19 @@ next_tmsg(Pid) -> bad_register(Config) when is_list(Config) -> Name = a_long_and_unused_name, - ?line {'EXIT',{badarg,_}} = (catch register({bad,name}, self())), - ?line fail_register(undefined, self()), - ?line fail_register([bad,name], self()), + {'EXIT',{badarg,_}} = (catch register({bad,name}, self())), + fail_register(undefined, self()), + fail_register([bad,name], self()), - ?line {Dead,Mref} = spawn_monitor(fun() -> true end), + {Dead,Mref} = spawn_monitor(fun() -> true end), receive {'DOWN',Mref,process,Dead,_} -> ok end, - ?line fail_register(Name, Dead), - ?line fail_register(Name, make_ref()), - ?line fail_register(Name, []), - ?line fail_register(Name, {bad,process}), - ?line fail_register(Name, <<>>), + fail_register(Name, Dead), + fail_register(Name, make_ref()), + fail_register(Name, []), + fail_register(Name, {bad,process}), + fail_register(Name, <<>>), ok. fail_register(Name, Process) -> @@ -1201,50 +1187,50 @@ fail_register(Name, Process) -> garbage_collect(doc) -> []; garbage_collect(suite) -> []; garbage_collect(Config) when is_list(Config) -> - ?line Prio = process_flag(priority, high), - ?line true = erlang:garbage_collect(), - ?line TokLoopers = lists:map(fun (_) -> - spawn_opt(fun tok_loop/0, - [{priority, low}, link]) - end, - lists:seq(1, 10)), - ?line lists:foreach(fun (Pid) -> - ?line Mon = erlang:monitor(process, Pid), - ?line DownBefore = receive - {'DOWN', Mon, _, _, _} -> - ?line true - after 0 -> - ?line false - end, - ?line GC = erlang:garbage_collect(Pid), - ?line DownAfter = receive - {'DOWN', Mon, _, _, _} -> - ?line true - after 0 -> - ?line false - end, - ?line true = erlang:demonitor(Mon), - ?line case {DownBefore, DownAfter} of - {true, _} -> ?line false = GC; - {false, false} -> ?line true = GC; - _ -> ?line GC - end - end, - processes()), - ?line lists:foreach(fun (Pid) -> - unlink(Pid), - exit(Pid, bang) - end, TokLoopers), - ?line process_flag(priority, Prio), - ?line ok. + Prio = process_flag(priority, high), + true = erlang:garbage_collect(), + + TokLoopers = lists:map(fun (_) -> + spawn_opt(fun tok_loop/0, [{priority, low}, link]) + end, lists:seq(1, 10)), + + lists:foreach(fun (Pid) -> + Mon = erlang:monitor(process, Pid), + DownBefore = receive + {'DOWN', Mon, _, _, _} -> + true + after 0 -> + false + end, + GC = erlang:garbage_collect(Pid), + DownAfter = receive + {'DOWN', Mon, _, _, _} -> + true + after 0 -> + false + end, + true = erlang:demonitor(Mon), + case {DownBefore, DownAfter} of + {true, _} -> false = GC; + {false, false} -> true = GC; + _ -> GC + end + end, processes()), + + lists:foreach(fun (Pid) -> + unlink(Pid), + exit(Pid, bang) + end, TokLoopers), + process_flag(priority, Prio), + ok. process_info_messages(doc) -> ["This used to cause the nofrag emulator to dump core"]; process_info_messages(suite) -> []; process_info_messages(Config) when is_list(Config) -> - ?line process_info_messages_test(), - ?line ok. + process_info_messages_test(), + ok. process_info_messages_loop(0) -> ok; process_info_messages_loop(N) -> process_info_messages_loop(N-1). @@ -1259,43 +1245,42 @@ process_info_messages_send_my_msgs_to(Rcvr) -> end. process_info_messages_test() -> - ?line Go = make_ref(), - ?line Done = make_ref(), - ?line Rcvr = self(), - ?line Rcvr2 = spawn_link(fun () -> - receive {Go, Rcvr} -> ok end, - garbage_collect(), - Rcvr ! {Done, self()} - end), - ?line Sndrs = lists:map( - fun (_) -> - spawn_link(fun () -> - Rcvr ! {Go, self()}, - receive {Go, Rcvr} -> ok end, - BigData = lists:seq(1, 1000), - Rcvr ! BigData, - Rcvr ! BigData, - Rcvr ! BigData, - Rcvr ! {Done, self()} - end) - end, - lists:seq(1, 10)), - ?line lists:foreach(fun (Sndr) -> receive {Go, Sndr} -> ok end end, + Go = make_ref(), + Done = make_ref(), + Rcvr = self(), + Rcvr2 = spawn_link(fun () -> + receive {Go, Rcvr} -> ok end, + garbage_collect(), + Rcvr ! {Done, self()} + end), + Sndrs = lists:map( + fun (_) -> + spawn_link(fun () -> + Rcvr ! {Go, self()}, + receive {Go, Rcvr} -> ok end, + BigData = lists:seq(1, 1000), + Rcvr ! BigData, + Rcvr ! BigData, + Rcvr ! BigData, + Rcvr ! {Done, self()} + end) + end, lists:seq(1, 10)), + lists:foreach(fun (Sndr) -> receive {Go, Sndr} -> ok end end, Sndrs), - ?line garbage_collect(), - ?line erlang:yield(), - ?line lists:foreach(fun (Sndr) -> Sndr ! {Go, self()} end, Sndrs), - ?line process_info_messages_loop(100000000), - ?line Msgs = process_info(self(), messages), - ?line lists:foreach(fun (Sndr) -> receive {Done, Sndr} -> ok end end, + garbage_collect(), + erlang:yield(), + lists:foreach(fun (Sndr) -> Sndr ! {Go, self()} end, Sndrs), + process_info_messages_loop(100000000), + Msgs = process_info(self(), messages), + lists:foreach(fun (Sndr) -> receive {Done, Sndr} -> ok end end, Sndrs), - ?line garbage_collect(), - ?line Rcvr2 ! Msgs, - ?line process_info_messages_send_my_msgs_to(Rcvr2), - ?line Rcvr2 ! {Go, self()}, - ?line garbage_collect(), - ?line receive {Done, Rcvr2} -> ok end, - ?line Msgs. + garbage_collect(), + Rcvr2 ! Msgs, + process_info_messages_send_my_msgs_to(Rcvr2), + Rcvr2 ! {Go, self()}, + garbage_collect(), + receive {Done, Rcvr2} -> ok end, + Msgs. chk_badarg(Fun) -> try Fun(), exit(no_badarg) catch error:badarg -> ok end. @@ -1305,76 +1290,72 @@ process_flag_badarg(doc) -> process_flag_badarg(suite) -> []; process_flag_badarg(Config) when is_list(Config) -> - ?line chk_badarg(fun () -> process_flag(gurka, banan) end), - ?line chk_badarg(fun () -> process_flag(trap_exit, gurka) end), - ?line chk_badarg(fun () -> process_flag(error_handler, 1) end), - ?line chk_badarg(fun () -> process_flag(min_heap_size, gurka) end), - ?line chk_badarg(fun () -> process_flag(min_bin_vheap_size, gurka) end), - ?line chk_badarg(fun () -> process_flag(min_bin_vheap_size, -1) end), - ?line chk_badarg(fun () -> process_flag(priority, 4711) end), - ?line chk_badarg(fun () -> process_flag(save_calls, hmmm) end), - ?line P= spawn_link(fun () -> receive die -> ok end end), - ?line chk_badarg(fun () -> process_flag(P, save_calls, hmmm) end), - ?line chk_badarg(fun () -> process_flag(gurka, save_calls, hmmm) end), - ?line P ! die, - ?line ok. + chk_badarg(fun () -> process_flag(gurka, banan) end), + chk_badarg(fun () -> process_flag(trap_exit, gurka) end), + chk_badarg(fun () -> process_flag(error_handler, 1) end), + chk_badarg(fun () -> process_flag(min_heap_size, gurka) end), + chk_badarg(fun () -> process_flag(min_bin_vheap_size, gurka) end), + chk_badarg(fun () -> process_flag(min_bin_vheap_size, -1) end), + chk_badarg(fun () -> process_flag(priority, 4711) end), + chk_badarg(fun () -> process_flag(save_calls, hmmm) end), + P= spawn_link(fun () -> receive die -> ok end end), + chk_badarg(fun () -> process_flag(P, save_calls, hmmm) end), + chk_badarg(fun () -> process_flag(gurka, save_calls, hmmm) end), + P ! die, + ok. -include_lib("stdlib/include/ms_transform.hrl"). otp_6237(doc) -> []; otp_6237(suite) -> []; otp_6237(Config) when is_list(Config) -> - ?line Slctrs = lists:map(fun (_) -> - spawn_link(fun () -> - otp_6237_select_loop() - end) - end, - lists:seq(1,5)), - ?line lists:foreach(fun (_) -> otp_6237_test() end, lists:seq(1, 100)), - ?line lists:foreach(fun (S) -> unlink(S),exit(S, kill) end, Slctrs), - ?line ok. + Slctrs = lists:map(fun (_) -> + spawn_link(fun () -> + otp_6237_select_loop() + end) + end, + lists:seq(1,5)), + lists:foreach(fun (_) -> otp_6237_test() end, lists:seq(1, 100)), + lists:foreach(fun (S) -> unlink(S),exit(S, kill) end, Slctrs), + ok. otp_6237_test() -> - ?line Parent = self(), - ?line Inited = make_ref(), - ?line Die = make_ref(), - ?line Pid = spawn_link(fun () -> - register(otp_6237,self()), - otp_6237 = ets:new(otp_6237, - [named_table, - ordered_set]), - ets:insert(otp_6237, - [{I,I} - || I <- lists:seq(1, 100)]), - %% Inserting a lot of bif timers - %% increase the possibility that - %% the test will fail when the - %% original cleanup order is used - lists:foreach( - fun (_) -> - erlang:send_after(1000000, - self(), - {a,b,c}) - end, - lists:seq(1,1000)), - Parent ! Inited, - receive Die -> bye end - end), - ?line receive - Inited -> ?line ok - end, - ?line Pid ! Die, + Parent = self(), + Inited = make_ref(), + Die = make_ref(), + Pid = spawn_link(fun () -> + register(otp_6237,self()), + otp_6237 = ets:new(otp_6237, + [named_table, + ordered_set]), + ets:insert(otp_6237, + [{I,I} + || I <- lists:seq(1, 100)]), + %% Inserting a lot of bif timers + %% increase the possibility that + %% the test will fail when the + %% original cleanup order is used + lists:foreach( fun (_) -> + erlang:send_after(1000000, self(), {a,b,c}) + end, lists:seq(1,1000)), + Parent ! Inited, + receive Die -> bye end + end), + receive + Inited -> ok + end, + Pid ! Die, otp_6237_whereis_loop(). otp_6237_whereis_loop() -> - ?line case whereis(otp_6237) of + case whereis(otp_6237) of undefined -> - ?line otp_6237 = ets:new(otp_6237, + otp_6237 = ets:new(otp_6237, [named_table,ordered_set]), - ?line ets:delete(otp_6237), - ?line ok; + ets:delete(otp_6237), + ok; _ -> - ?line otp_6237_whereis_loop() + otp_6237_whereis_loop() end. otp_6237_select_loop() -> @@ -1382,7 +1363,6 @@ otp_6237_select_loop() -> otp_6237_select_loop(). - -define(NoTestProcs, 10000). -record(ptab_list_bif_info, {min_start_reds, tab_chunks, @@ -1399,42 +1379,42 @@ processes_large_tab(doc) -> processes_large_tab(suite) -> []; processes_large_tab(Config) when is_list(Config) -> - ?line enable_internal_state(), - ?line MaxDbgLvl = 20, - ?line MinProcTabSize = 2*(1 bsl 15), - ?line ProcTabSize0 = 1000000, - ?line ProcTabSize1 = case {erlang:system_info(schedulers_online), - erlang:system_info(logical_processors)} of - {Schdlrs, Cpus} when is_integer(Cpus), - Schdlrs =< Cpus -> - ProcTabSize0; - _ -> - ProcTabSize0 div 4 - end, - ?line ProcTabSize2 = case erlang:system_info(debug_compiled) of - true -> ProcTabSize1 - 500000; - false -> ProcTabSize1 - end, + enable_internal_state(), + MaxDbgLvl = 20, + MinProcTabSize = 2*(1 bsl 15), + ProcTabSize0 = 1000000, + ProcTabSize1 = case {erlang:system_info(schedulers_online), + erlang:system_info(logical_processors)} of + {Schdlrs, Cpus} when is_integer(Cpus), + Schdlrs =< Cpus -> + ProcTabSize0; + _ -> + ProcTabSize0 div 4 + end, + ProcTabSize2 = case erlang:system_info(debug_compiled) of + true -> ProcTabSize1 - 500000; + false -> ProcTabSize1 + end, %% With high debug levels this test takes so long time that %% the connection times out; therefore, shrink the test on %% high debug levels. - ?line DbgLvl = case erts_debug:get_internal_state(processes_bif_info) of + DbgLvl = case erts_debug:get_internal_state(processes_bif_info) of #ptab_list_bif_info{debug_level = Lvl} when Lvl > MaxDbgLvl -> 20; #ptab_list_bif_info{debug_level = Lvl} when Lvl < 0 -> - ?line ?t:fail({debug_level, Lvl}); + ?t:fail({debug_level, Lvl}); #ptab_list_bif_info{debug_level = Lvl} -> Lvl end, - ?line ProcTabSize3 = ProcTabSize2 - (1300000 * DbgLvl div MaxDbgLvl), - ?line ProcTabSize = case ProcTabSize3 < MinProcTabSize of + ProcTabSize3 = ProcTabSize2 - (1300000 * DbgLvl div MaxDbgLvl), + ProcTabSize = case ProcTabSize3 < MinProcTabSize of true -> MinProcTabSize; false -> ProcTabSize3 end, - ?line {ok, LargeNode} = start_node(Config, + {ok, LargeNode} = start_node(Config, "+P " ++ integer_to_list(ProcTabSize)), - ?line Res = rpc:call(LargeNode, ?MODULE, processes_bif_test, []), - ?line case rpc:call(LargeNode, + Res = rpc:call(LargeNode, ?MODULE, processes_bif_test, []), + case rpc:call(LargeNode, erts_debug, get_internal_state, [processes_bif_info]) of @@ -1442,40 +1422,37 @@ processes_large_tab(Config) when is_list(Config) -> Chunks > 1 -> ok; PBInfo -> ?t:fail(PBInfo) end, - ?line stop_node(LargeNode), - ?line chk_processes_bif_test_res(Res). + stop_node(LargeNode), + chk_processes_bif_test_res(Res). processes_default_tab(doc) -> []; processes_default_tab(suite) -> []; processes_default_tab(Config) when is_list(Config) -> - ?line {ok, DefaultNode} = start_node(Config, ""), - ?line Res = rpc:call(DefaultNode, ?MODULE, processes_bif_test, []), - ?line stop_node(DefaultNode), - ?line chk_processes_bif_test_res(Res). + {ok, DefaultNode} = start_node(Config, ""), + Res = rpc:call(DefaultNode, ?MODULE, processes_bif_test, []), + stop_node(DefaultNode), + chk_processes_bif_test_res(Res). processes_small_tab(doc) -> []; processes_small_tab(suite) -> []; processes_small_tab(Config) when is_list(Config) -> - ?line {ok, SmallNode} = start_node(Config, "+P 1024"), - ?line Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []), - ?line PBInfo = rpc:call(SmallNode, - erts_debug, - get_internal_state, - [processes_bif_info]), - ?line stop_node(SmallNode), - ?line true = PBInfo#ptab_list_bif_info.tab_chunks < 10, - ?line chk_processes_bif_test_res(Res). + {ok, SmallNode} = start_node(Config, "+P 1024"), + Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []), + PBInfo = rpc:call(SmallNode, erts_debug, get_internal_state, [processes_bif_info]), + stop_node(SmallNode), + true = PBInfo#ptab_list_bif_info.tab_chunks < 10, + chk_processes_bif_test_res(Res). processes_this_tab(doc) -> []; processes_this_tab(suite) -> []; processes_this_tab(Config) when is_list(Config) -> - ?line chk_processes_bif_test_res(processes_bif_test()). + chk_processes_bif_test_res(processes_bif_test()). chk_processes_bif_test_res(ok) -> ok; chk_processes_bif_test_res({comment, _} = Comment) -> Comment; @@ -1575,26 +1552,26 @@ do_processes(WantReds) -> processes(). processes_bif_test() -> - ?line Tester = self(), - ?line enable_internal_state(), - ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), - ?line print_processes_bif_info(PBInfo), - ?line WantReds = PBInfo#ptab_list_bif_info.min_start_reds + 10, - ?line WillTrap = case PBInfo of - #ptab_list_bif_info{tab_chunks = Chunks} when Chunks < 10 -> - false; %% Skip for small tables - #ptab_list_bif_info{tab_chunks = Chunks, - tab_chunks_size = ChunksSize, - tab_indices_per_red = IndiciesPerRed - } -> - Chunks*ChunksSize >= IndiciesPerRed*WantReds - end, - ?line Processes = fun () -> - erts_debug:set_internal_state(reds_left,WantReds), - processes() - end, + Tester = self(), + enable_internal_state(), + PBInfo = erts_debug:get_internal_state(processes_bif_info), + print_processes_bif_info(PBInfo), + WantReds = PBInfo#ptab_list_bif_info.min_start_reds + 10, + WillTrap = case PBInfo of + #ptab_list_bif_info{tab_chunks = Chunks} when Chunks < 10 -> + false; %% Skip for small tables + #ptab_list_bif_info{tab_chunks = Chunks, + tab_chunks_size = ChunksSize, + tab_indices_per_red = IndiciesPerRed + } -> + Chunks*ChunksSize >= IndiciesPerRed*WantReds + end, + Processes = fun () -> + erts_debug:set_internal_state(reds_left,WantReds), + processes() + end, - ?line ok = do_processes_bif_test(WantReds, WillTrap, Processes), + ok = do_processes_bif_test(WantReds, WillTrap, Processes), case WillTrap of false -> @@ -1602,8 +1579,8 @@ processes_bif_test() -> true -> %% Do it again with a process suspended while %% in the processes/0 bif. - ?line erlang:system_flag(multi_scheduling, block), - ?line Suspendee = spawn_link(fun () -> + erlang:system_flag(multi_scheduling, block), + Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), done, @@ -1613,175 +1590,156 @@ processes_bif_test() -> ok end end), - ?line receive {suspend_me, Suspendee} -> ok end, - ?line erlang:suspend_process(Suspendee), - ?line erlang:system_flag(multi_scheduling, unblock), + receive {suspend_me, Suspendee} -> ok end, + erlang:suspend_process(Suspendee), + erlang:system_flag(multi_scheduling, unblock), - ?line [{status,suspended}, - {current_function,{erlang,ptab_list_continue,2}}] - = process_info(Suspendee, [status, current_function]), + [{status,suspended},{current_function,{erlang,ptab_list_continue,2}}] = + process_info(Suspendee, [status, current_function]), - ?line ok = do_processes_bif_test(WantReds, WillTrap, Processes), + ok = do_processes_bif_test(WantReds, WillTrap, Processes), - ?line erlang:resume_process(Suspendee), - ?line receive {Suspendee, done, _} -> ok end, - ?line unlink(Suspendee), - ?line exit(Suspendee, bang) + erlang:resume_process(Suspendee), + receive {Suspendee, done, _} -> ok end, + unlink(Suspendee), + exit(Suspendee, bang) end, case get(processes_bif_testcase_comment) of - undefined -> ?line ok; - Comment -> ?line {comment, Comment} + undefined -> ok; + Comment -> {comment, Comment} end. do_processes_bif_test(WantReds, DieTest, Processes) -> - ?line Tester = self(), - ?line SpawnProcesses = fun (Prio) -> - spawn_opt(?MODULE, - do_processes, - [WantReds], - [link, {priority, Prio}]) - end, - ?line Cleaner = spawn_link(fun () -> - process_flag(trap_exit, true), - Tester ! {cleaner_alive, self()}, - processes_bif_cleaner() - end), - ?line receive {cleaner_alive, Cleaner} -> ok end, + Tester = self(), + SpawnProcesses = fun (Prio) -> + spawn_opt(?MODULE, do_processes, [WantReds], [link, {priority, Prio}]) + end, + Cleaner = spawn_link(fun () -> + process_flag(trap_exit, true), + Tester ! {cleaner_alive, self()}, + processes_bif_cleaner() + end), + receive {cleaner_alive, Cleaner} -> ok end, try - ?line DoIt = make_ref(), - ?line GetGoing = make_ref(), - ?line {NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner), - ?line ?t:format("Testing with ~p processes~n", [NoTestProcs]), - ?line SpawnHangAround = fun () -> - spawn(?MODULE, - hangaround, - [Cleaner, new_hangaround]) - end, - ?line Killer = spawn_opt(fun () -> - Splt = NoTestProcs div 10, - {TP1, TP23} = lists:split(Splt, - TestProcs), - {TP2, TP3} = lists:split(Splt, TP23), - erlang:system_flag(multi_scheduling, - block), - Tester ! DoIt, - receive GetGoing -> ok end, - erlang:system_flag(multi_scheduling, - unblock), - SpawnProcesses(high), - lists:foreach( - fun (P) -> - SpawnHangAround(), - exit(P, bang) - end, - TP1), - SpawnProcesses(high), - erlang:yield(), - lists:foreach( - fun (P) -> - SpawnHangAround(), - exit(P, bang) - end, - TP2), - SpawnProcesses(high), - lists:foreach( - fun (P) -> - SpawnHangAround(), - exit(P, bang) - end, - TP3) - end, - [{priority, high}, link]), - ?line receive DoIt -> ok end, - ?line process_flag(priority, low), - ?line SpawnProcesses(low), - ?line erlang:yield(), - ?line process_flag(priority, normal), - ?line CorrectProcs0 = erts_debug:get_internal_state(processes), - ?line Killer ! GetGoing, - ?line erts_debug:set_internal_state(reds_left, WantReds), - ?line Procs0 = processes(), - ?line Procs = lists:sort(Procs0), - ?line CorrectProcs = lists:sort(CorrectProcs0), - ?line LengthCorrectProcs = length(CorrectProcs), - ?line ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), - ?line true = LengthCorrectProcs > NoTestProcs, - ?line case CorrectProcs =:= Procs of - true -> - ?line ok; - false -> - ?line processes_unexpected_result(CorrectProcs, Procs) - end, - ?line unlink(Killer), - ?line exit(Killer, bang) + DoIt = make_ref(), + GetGoing = make_ref(), + {NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner), + ?t:format("Testing with ~p processes~n", [NoTestProcs]), + SpawnHangAround = fun () -> + spawn(?MODULE, hangaround, [Cleaner, new_hangaround]) + end, + Killer = spawn_opt(fun () -> + Splt = NoTestProcs div 10, + {TP1, TP23} = lists:split(Splt, TestProcs), + {TP2, TP3} = lists:split(Splt, TP23), + erlang:system_flag(multi_scheduling, block), + Tester ! DoIt, + receive GetGoing -> ok end, + erlang:system_flag(multi_scheduling, unblock), + SpawnProcesses(high), + lists:foreach( fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, TP1), + SpawnProcesses(high), + erlang:yield(), + lists:foreach( fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, TP2), + SpawnProcesses(high), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, TP3) + end, [{priority, high}, link]), + receive DoIt -> ok end, + process_flag(priority, low), + SpawnProcesses(low), + erlang:yield(), + process_flag(priority, normal), + CorrectProcs0 = erts_debug:get_internal_state(processes), + Killer ! GetGoing, + erts_debug:set_internal_state(reds_left, WantReds), + Procs0 = processes(), + Procs = lists:sort(Procs0), + CorrectProcs = lists:sort(CorrectProcs0), + LengthCorrectProcs = length(CorrectProcs), + ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), + true = LengthCorrectProcs > NoTestProcs, + case CorrectProcs =:= Procs of + true -> + ok; + false -> + processes_unexpected_result(CorrectProcs, Procs) + end, + unlink(Killer), + exit(Killer, bang) after unlink(Cleaner), exit(Cleaner, kill), %% Wait for the system to recover to a normal state... wait_until_system_recover() end, - ?line do_processes_bif_die_test(DieTest, Processes), - ?line ok. + do_processes_bif_die_test(DieTest, Processes), + ok. do_processes_bif_die_test(false, _Processes) -> - ?line ?t:format("Skipping test killing process executing processes/0~n",[]), - ?line ok; + ?t:format("Skipping test killing process executing processes/0~n",[]), + ok; do_processes_bif_die_test(true, Processes) -> - ?line do_processes_bif_die_test(5, Processes); + do_processes_bif_die_test(5, Processes); do_processes_bif_die_test(N, Processes) -> - ?line ?t:format("Doing test killing process executing processes/0~n",[]), + ?t:format("Doing test killing process executing processes/0~n",[]), try - ?line Tester = self(), - ?line Oooh_Nooooooo = make_ref(), - ?line {_, DieWhileDoingMon} = erlang:spawn_monitor( - fun () -> - Victim = self(), - spawn_opt( - fun () -> - exit(Victim, got_him) - end, - [link, - {priority, max}]), - Tester ! {Oooh_Nooooooo, - hd(Processes())}, - exit(ohhhh_nooooo) - end), - ?line receive - {'DOWN', DieWhileDoingMon, _, _, Reason} -> - case Reason of - got_him -> ok; - _ -> throw({kill_in_trap, Reason}) - end - end, - ?line receive - {Oooh_Nooooooo, _} -> - ?line throw({kill_in_trap, 'Oooh_Nooooooo'}) - after 0 -> - ?line ok - end, - ?line PrcsCllrsSeqLen = 2*erlang:system_info(schedulers_online), - ?line PrcsCllrsSeq = lists:seq(1, PrcsCllrsSeqLen), - ?line ProcsCallers = lists:map( - fun (_) -> - spawn_link( - fun () -> - Tester ! hd(Processes()) - end) - end, - PrcsCllrsSeq), - ?line erlang:yield(), + Tester = self(), + Oooh_Nooooooo = make_ref(), + {_, DieWhileDoingMon} = erlang:spawn_monitor( fun () -> + Victim = self(), + spawn_opt( + fun () -> + exit(Victim, got_him) + end, + [link, {priority, max}]), + Tester ! {Oooh_Nooooooo, + hd(Processes())}, + exit(ohhhh_nooooo) + end), + receive + {'DOWN', DieWhileDoingMon, _, _, Reason} -> + case Reason of + got_him -> ok; + _ -> throw({kill_in_trap, Reason}) + end + end, + receive + {Oooh_Nooooooo, _} -> + throw({kill_in_trap, 'Oooh_Nooooooo'}) + after 0 -> + ok + end, + PrcsCllrsSeqLen = 2*erlang:system_info(schedulers_online), + PrcsCllrsSeq = lists:seq(1, PrcsCllrsSeqLen), + ProcsCallers = lists:map( fun (_) -> + spawn_link( + fun () -> + Tester ! hd(Processes()) + end) + end, PrcsCllrsSeq), + erlang:yield(), {ProcsCallers1, ProcsCallers2} = lists:split(PrcsCllrsSeqLen div 2, ProcsCallers), - ?line process_flag(priority, high), - ?line lists:foreach( + process_flag(priority, high), + lists:foreach( fun (P) -> unlink(P), exit(P, bang) end, lists:reverse(ProcsCallers2) ++ ProcsCallers1), - ?line process_flag(priority, normal), - ?line ok + process_flag(priority, normal), + ok catch throw:{kill_in_trap, R} when N > 0 -> ?t:format("Failed to kill in trap: ~p~n", [R]), @@ -1844,23 +1802,23 @@ processes_last_call_trap(doc) -> processes_last_call_trap(suite) -> []; processes_last_call_trap(Config) when is_list(Config) -> - ?line enable_internal_state(), - ?line Processes = fun () -> processes() end, - ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), - ?line print_processes_bif_info(PBInfo), - ?line WantReds = case PBInfo#ptab_list_bif_info.min_start_reds of - R when R > 10 -> R - 1; - _R -> 9 - end, - ?line lists:foreach(fun (_) -> - ?line erts_debug:set_internal_state(reds_left, - WantReds), - Processes(), - ?line erts_debug:set_internal_state(reds_left, - WantReds), - my_processes() - end, - lists:seq(1,100)). + enable_internal_state(), + Processes = fun () -> processes() end, + PBInfo = erts_debug:get_internal_state(processes_bif_info), + print_processes_bif_info(PBInfo), + WantReds = case PBInfo#ptab_list_bif_info.min_start_reds of + R when R > 10 -> R - 1; + _R -> 9 + end, + lists:foreach(fun (_) -> + erts_debug:set_internal_state(reds_left, + WantReds), + Processes(), + erts_debug:set_internal_state(reds_left, + WantReds), + my_processes() + end, + lists:seq(1,100)). my_processes() -> processes(). @@ -1870,108 +1828,106 @@ processes_apply_trap(doc) -> processes_apply_trap(suite) -> []; processes_apply_trap(Config) when is_list(Config) -> - ?line enable_internal_state(), - ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), - ?line print_processes_bif_info(PBInfo), - ?line WantReds = case PBInfo#ptab_list_bif_info.min_start_reds of - R when R > 10 -> R - 1; - _R -> 9 - end, - ?line lists:foreach(fun (_) -> - ?line erts_debug:set_internal_state(reds_left, - WantReds), - ?line apply(erlang, processes, []) - end, - lists:seq(1,100)). + enable_internal_state(), + PBInfo = erts_debug:get_internal_state(processes_bif_info), + print_processes_bif_info(PBInfo), + WantReds = case PBInfo#ptab_list_bif_info.min_start_reds of + R when R > 10 -> R - 1; + _R -> 9 + end, + lists:foreach(fun (_) -> + erts_debug:set_internal_state(reds_left, + WantReds), + apply(erlang, processes, []) + end, lists:seq(1,100)). processes_gc_trap(doc) -> []; processes_gc_trap(suite) -> []; processes_gc_trap(Config) when is_list(Config) -> - ?line Tester = self(), - ?line enable_internal_state(), - ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), - ?line print_processes_bif_info(PBInfo), - ?line WantReds = PBInfo#ptab_list_bif_info.min_start_reds + 10, - ?line Processes = fun () -> - erts_debug:set_internal_state(reds_left,WantReds), - processes() - end, + Tester = self(), + enable_internal_state(), + PBInfo = erts_debug:get_internal_state(processes_bif_info), + print_processes_bif_info(PBInfo), + WantReds = PBInfo#ptab_list_bif_info.min_start_reds + 10, + Processes = fun () -> + erts_debug:set_internal_state(reds_left,WantReds), + processes() + end, - ?line erlang:system_flag(multi_scheduling, block), - ?line Suspendee = spawn_link(fun () -> + erlang:system_flag(multi_scheduling, block), + Suspendee = spawn_link(fun () -> Tester ! {suspend_me, self()}, Tester ! {self(), done, hd(Processes())}, receive after infinity -> ok end end), - ?line receive {suspend_me, Suspendee} -> ok end, - ?line erlang:suspend_process(Suspendee), - ?line erlang:system_flag(multi_scheduling, unblock), + receive {suspend_me, Suspendee} -> ok end, + erlang:suspend_process(Suspendee), + erlang:system_flag(multi_scheduling, unblock), - ?line [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] + [{status,suspended}, {current_function,{erlang,ptab_list_continue,2}}] = process_info(Suspendee, [status, current_function]), - ?line erlang:garbage_collect(Suspendee), - ?line erlang:garbage_collect(Suspendee), + erlang:garbage_collect(Suspendee), + erlang:garbage_collect(Suspendee), - ?line erlang:resume_process(Suspendee), - ?line receive {Suspendee, done, _} -> ok end, - ?line erlang:garbage_collect(Suspendee), - ?line erlang:garbage_collect(Suspendee), + erlang:resume_process(Suspendee), + receive {Suspendee, done, _} -> ok end, + erlang:garbage_collect(Suspendee), + erlang:garbage_collect(Suspendee), - ?line unlink(Suspendee), - ?line exit(Suspendee, bang), - ?line ok. + unlink(Suspendee), + exit(Suspendee, bang), + ok. process_flag_heap_size(doc) -> []; process_flag_heap_size(suite) -> []; process_flag_heap_size(Config) when is_list(Config) -> - HSize = 2584, % must be gc fib number - VHSize = 317811, % must be gc fib number - ?line OldHmin = erlang:process_flag(min_heap_size, HSize), - ?line {min_heap_size, HSize} = erlang:process_info(self(), min_heap_size), - ?line OldVHmin = erlang:process_flag(min_bin_vheap_size, VHSize), - ?line {min_bin_vheap_size, VHSize} = erlang:process_info(self(), min_bin_vheap_size), - ?line HSize = erlang:process_flag(min_heap_size, OldHmin), - ?line VHSize = erlang:process_flag(min_bin_vheap_size, OldVHmin), - ?line ok. + HSize = 2586, % must be gc fib+ number + VHSize = 318187, % must be gc fib+ number + OldHmin = erlang:process_flag(min_heap_size, HSize), + {min_heap_size, HSize} = erlang:process_info(self(), min_heap_size), + OldVHmin = erlang:process_flag(min_bin_vheap_size, VHSize), + {min_bin_vheap_size, VHSize} = erlang:process_info(self(), min_bin_vheap_size), + HSize = erlang:process_flag(min_heap_size, OldHmin), + VHSize = erlang:process_flag(min_bin_vheap_size, OldVHmin), + ok. spawn_opt_heap_size(doc) -> []; spawn_opt_heap_size(suite) -> []; spawn_opt_heap_size(Config) when is_list(Config) -> - HSize = 987, % must be gc fib number - VHSize = 46368, % must be gc fib number - ?line Pid = spawn_opt(fun () -> receive stop -> ok end end, + HSize = 987, % must be gc fib+ number + VHSize = 46422, % must be gc fib+ number + Pid = spawn_opt(fun () -> receive stop -> ok end end, [{min_heap_size, HSize},{ min_bin_vheap_size, VHSize}]), - ?line {min_heap_size, HSize} = process_info(Pid, min_heap_size), - ?line {min_bin_vheap_size, VHSize} = process_info(Pid, min_bin_vheap_size), - ?line Pid ! stop, - ?line ok. + {min_heap_size, HSize} = process_info(Pid, min_heap_size), + {min_bin_vheap_size, VHSize} = process_info(Pid, min_bin_vheap_size), + Pid ! stop, + ok. processes_term_proc_list(doc) -> []; processes_term_proc_list(suite) -> []; processes_term_proc_list(Config) when is_list(Config) -> - ?line Tester = self(), - ?line as_expected = processes_term_proc_list_test(false), - ?line {ok, Node} = start_node(Config, "+Mis true"), - ?line RT = spawn_link(Node, - fun () -> - receive after 1000 -> ok end, - processes_term_proc_list_test(false), - Tester ! {it_worked, self()} - end), - ?line receive {it_worked, RT} -> ok end, - ?line stop_node(Node), - ?line ok. + Tester = self(), + as_expected = processes_term_proc_list_test(false), + {ok, Node} = start_node(Config, "+Mis true"), + RT = spawn_link(Node, fun () -> + receive after 1000 -> ok end, + processes_term_proc_list_test(false), + Tester ! {it_worked, self()} + end), + receive {it_worked, RT} -> ok end, + stop_node(Node), + ok. -define(CHK_TERM_PROC_LIST(MC, XB), chk_term_proc_list(?LINE, MC, XB)). @@ -1997,35 +1953,34 @@ chk_term_proc_list(Line, MustChk, ExpectBlks) -> ok. processes_term_proc_list_test(MustChk) -> - ?line Tester = self(), - ?line enable_internal_state(), - ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), - ?line print_processes_bif_info(PBInfo), - ?line WantReds = PBInfo#ptab_list_bif_info.min_start_reds + 10, - ?line #ptab_list_bif_info{tab_chunks = Chunks, - tab_chunks_size = ChunksSize, - tab_indices_per_red = IndiciesPerRed - } = PBInfo, - ?line true = Chunks > 1, - ?line true = Chunks*ChunksSize >= IndiciesPerRed*WantReds, - ?line Processes = fun () -> - erts_debug:set_internal_state(reds_left, - WantReds), - processes() - end, - ?line Exit = fun (P) -> - unlink(P), - exit(P, bang), - wait_until( - fun () -> - not lists:member( - P, - erts_debug:get_internal_state( - processes)) - end) - end, - ?line SpawnSuspendProcessesProc - = fun () -> + Tester = self(), + enable_internal_state(), + PBInfo = erts_debug:get_internal_state(processes_bif_info), + print_processes_bif_info(PBInfo), + WantReds = PBInfo#ptab_list_bif_info.min_start_reds + 10, + #ptab_list_bif_info{tab_chunks = Chunks, + tab_chunks_size = ChunksSize, + tab_indices_per_red = IndiciesPerRed + } = PBInfo, + true = Chunks > 1, + true = Chunks*ChunksSize >= IndiciesPerRed*WantReds, + Processes = fun () -> + erts_debug:set_internal_state(reds_left, + WantReds), + processes() + end, + Exit = fun (P) -> + unlink(P), + exit(P, bang), + wait_until( + fun () -> + not lists:member( + P, + erts_debug:get_internal_state( + processes)) + end) + end, + SpawnSuspendProcessesProc = fun () -> erlang:system_flag(multi_scheduling, block), P = spawn_link(fun () -> Tester ! {suspend_me, self()}, @@ -2042,72 +1997,72 @@ processes_term_proc_list_test(MustChk) -> = process_info(P, [status, current_function]), P end, - ?line ResumeProcessesProc = fun (P) -> + ResumeProcessesProc = fun (P) -> erlang:resume_process(P), receive {P, done, _} -> ok end end, - ?line ?CHK_TERM_PROC_LIST(MustChk, 0), - ?line HangAround = fun () -> receive after infinity -> ok end end, - ?line HA1 = spawn_link(HangAround), - ?line HA2 = spawn_link(HangAround), - ?line HA3 = spawn_link(HangAround), - ?line S1 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 1), - ?line Exit(HA1), - ?line ?CHK_TERM_PROC_LIST(MustChk, 2), - ?line S2 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 3), - ?line S3 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 4), - ?line Exit(HA2), - ?line ?CHK_TERM_PROC_LIST(MustChk, 5), - ?line S4 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 6), - ?line Exit(HA3), - ?line ?CHK_TERM_PROC_LIST(MustChk, 7), - ?line ResumeProcessesProc(S1), - ?line ?CHK_TERM_PROC_LIST(MustChk, 5), - ?line ResumeProcessesProc(S3), - ?line ?CHK_TERM_PROC_LIST(MustChk, 4), - ?line ResumeProcessesProc(S4), - ?line ?CHK_TERM_PROC_LIST(MustChk, 3), - ?line ResumeProcessesProc(S2), - ?line ?CHK_TERM_PROC_LIST(MustChk, 0), - ?line Exit(S1), - ?line Exit(S2), - ?line Exit(S3), - ?line Exit(S4), - - - ?line HA4 = spawn_link(HangAround), - ?line HA5 = spawn_link(HangAround), - ?line HA6 = spawn_link(HangAround), - ?line S5 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 1), - ?line Exit(HA4), - ?line ?CHK_TERM_PROC_LIST(MustChk, 2), - ?line S6 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 3), - ?line Exit(HA5), - ?line ?CHK_TERM_PROC_LIST(MustChk, 4), - ?line S7 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 5), - ?line Exit(HA6), - ?line ?CHK_TERM_PROC_LIST(MustChk, 6), - ?line S8 = SpawnSuspendProcessesProc(), - ?line ?CHK_TERM_PROC_LIST(MustChk, 7), - - ?line erlang:system_flag(multi_scheduling, block), - ?line Exit(S8), - ?line ?CHK_TERM_PROC_LIST(MustChk, 7), - ?line Exit(S5), - ?line ?CHK_TERM_PROC_LIST(MustChk, 6), - ?line Exit(S7), - ?line ?CHK_TERM_PROC_LIST(MustChk, 6), - ?line Exit(S6), - ?line ?CHK_TERM_PROC_LIST(MustChk, 0), - ?line erlang:system_flag(multi_scheduling, unblock), - ?line as_expected. + ?CHK_TERM_PROC_LIST(MustChk, 0), + HangAround = fun () -> receive after infinity -> ok end end, + HA1 = spawn_link(HangAround), + HA2 = spawn_link(HangAround), + HA3 = spawn_link(HangAround), + S1 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 1), + Exit(HA1), + ?CHK_TERM_PROC_LIST(MustChk, 2), + S2 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 3), + S3 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 4), + Exit(HA2), + ?CHK_TERM_PROC_LIST(MustChk, 5), + S4 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 6), + Exit(HA3), + ?CHK_TERM_PROC_LIST(MustChk, 7), + ResumeProcessesProc(S1), + ?CHK_TERM_PROC_LIST(MustChk, 5), + ResumeProcessesProc(S3), + ?CHK_TERM_PROC_LIST(MustChk, 4), + ResumeProcessesProc(S4), + ?CHK_TERM_PROC_LIST(MustChk, 3), + ResumeProcessesProc(S2), + ?CHK_TERM_PROC_LIST(MustChk, 0), + Exit(S1), + Exit(S2), + Exit(S3), + Exit(S4), + + + HA4 = spawn_link(HangAround), + HA5 = spawn_link(HangAround), + HA6 = spawn_link(HangAround), + S5 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 1), + Exit(HA4), + ?CHK_TERM_PROC_LIST(MustChk, 2), + S6 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 3), + Exit(HA5), + ?CHK_TERM_PROC_LIST(MustChk, 4), + S7 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 5), + Exit(HA6), + ?CHK_TERM_PROC_LIST(MustChk, 6), + S8 = SpawnSuspendProcessesProc(), + ?CHK_TERM_PROC_LIST(MustChk, 7), + + erlang:system_flag(multi_scheduling, block), + Exit(S8), + ?CHK_TERM_PROC_LIST(MustChk, 7), + Exit(S5), + ?CHK_TERM_PROC_LIST(MustChk, 6), + Exit(S7), + ?CHK_TERM_PROC_LIST(MustChk, 6), + Exit(S6), + ?CHK_TERM_PROC_LIST(MustChk, 0), + erlang:system_flag(multi_scheduling, unblock), + as_expected. otp_7738_waiting(doc) -> @@ -2115,88 +2070,88 @@ otp_7738_waiting(doc) -> otp_7738_waiting(suite) -> []; otp_7738_waiting(Config) when is_list(Config) -> - ?line otp_7738_test(waiting). + otp_7738_test(waiting). otp_7738_suspended(doc) -> []; otp_7738_suspended(suite) -> []; otp_7738_suspended(Config) when is_list(Config) -> - ?line otp_7738_test(suspended). + otp_7738_test(suspended). otp_7738_resume(doc) -> []; otp_7738_resume(suite) -> []; otp_7738_resume(Config) when is_list(Config) -> - ?line otp_7738_test(resume). + otp_7738_test(resume). otp_7738_test(Type) -> - ?line T = self(), - ?line S = spawn_link(fun () -> - receive - {suspend, Suspendee} -> - erlang:suspend_process(Suspendee), - T ! {suspended, Suspendee}, - receive - after 10 -> - erlang:resume_process(Suspendee), - Suspendee ! wake_up - end; - {send, To, Msg} -> - receive after 10 -> ok end, - To ! Msg - end - end), - ?line R = spawn_link(fun () -> - X = lists:seq(1, 20000000), - T ! {initialized, self()}, - ?line case Type of - _ when Type == suspended; - Type == waiting -> - receive _ -> ok end; - _ when Type == resume -> - Receive = fun (F) -> - receive - _ -> - ok - after 0 -> - F(F) - end - end, - Receive(Receive) - end, - T ! {woke_up, self()}, - id(X) - end), - ?line receive {initialized, R} -> ok end, - ?line receive after 10 -> ok end, - ?line case Type of + T = self(), + S = spawn_link(fun () -> + receive + {suspend, Suspendee} -> + erlang:suspend_process(Suspendee), + T ! {suspended, Suspendee}, + receive + after 10 -> + erlang:resume_process(Suspendee), + Suspendee ! wake_up + end; + {send, To, Msg} -> + receive after 10 -> ok end, + To ! Msg + end + end), + R = spawn_link(fun () -> + X = lists:seq(1, 20000000), + T ! {initialized, self()}, + case Type of + _ when Type == suspended; + Type == waiting -> + receive _ -> ok end; + _ when Type == resume -> + Receive = fun (F) -> + receive + _ -> + ok + after 0 -> + F(F) + end + end, + Receive(Receive) + end, + T ! {woke_up, self()}, + id(X) + end), + receive {initialized, R} -> ok end, + receive after 10 -> ok end, + case Type of suspended -> - ?line erlang:suspend_process(R), - ?line S ! {send, R, wake_up}; + erlang:suspend_process(R), + S ! {send, R, wake_up}; waiting -> - ?line S ! {send, R, wake_up}; + S ! {send, R, wake_up}; resume -> - ?line S ! {suspend, R}, - ?line receive {suspended, R} -> ok end + S ! {suspend, R}, + receive {suspended, R} -> ok end end, - ?line erlang:garbage_collect(R), - ?line case Type of + erlang:garbage_collect(R), + case Type of suspended -> - ?line erlang:resume_process(R); + erlang:resume_process(R); _ -> - ?line ok + ok end, - ?line receive + receive {woke_up, R} -> - ?line ok + ok after 2000 -> - ?line I = process_info(R, [status, message_queue_len]), - ?line ?t:format("~p~n", [I]), - ?line ?t:fail(no_progress) + I = process_info(R, [status, message_queue_len]), + ?t:format("~p~n", [I]), + ?t:fail(no_progress) end, - ?line ok. + ok. gor(Reds, Stop) -> receive @@ -2210,28 +2165,28 @@ gor(Reds, Stop) -> end. garb_other_running(Config) when is_list(Config) -> - ?line Stop = make_ref(), - ?line {Pid, Mon} = spawn_monitor(fun () -> gor(0, Stop) end), - ?line Reds = lists:foldl(fun (_, OldReds) -> - ?line erlang:garbage_collect(Pid), - ?line receive after 1 -> ok end, - ?line Pid ! {self(), reds}, - ?line receive + Stop = make_ref(), + {Pid, Mon} = spawn_monitor(fun () -> gor(0, Stop) end), + Reds = lists:foldl(fun (_, OldReds) -> + erlang:garbage_collect(Pid), + receive after 1 -> ok end, + Pid ! {self(), reds}, + receive {reds, NewReds, Pid} -> - ?line true = (NewReds > OldReds), - ?line NewReds + true = (NewReds > OldReds), + NewReds end end, 0, lists:seq(1, 10000)), - ?line receive after 1 -> ok end, - ?line Pid ! {self(), Stop}, - ?line receive + receive after 1 -> ok end, + Pid ! {self(), Stop}, + receive {stopped, Stop, StopReds, Pid} -> - ?line true = (StopReds > Reds) + true = (StopReds > Reds) end, - ?line receive {'DOWN', Mon, process, Pid, normal} -> ok end, - ?line ok. + receive {'DOWN', Mon, process, Pid, normal} -> ok end, + ok. %% Internal functions @@ -2255,9 +2210,9 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) + Pa = filename:dirname(code:which(?MODULE)), + {A, B, C} = now(), + Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(?config(testcase, Config)) ++ "-" @@ -2266,7 +2221,7 @@ start_node(Config, Args) when is_list(Config) -> ++ integer_to_list(B) ++ "-" ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). stop_node(Node) -> ?t:stop_node(Node). diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index bfc3910742..a3b2764a5d 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -20,6 +20,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, t_size/1, t_tuple_size/1, t_element/1, t_setelement/1, + t_insert_element/1, t_delete_element/1, t_list_to_tuple/1, t_tuple_to_list/1, t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1, build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). @@ -41,6 +42,7 @@ all() -> [build_and_match, t_size, t_tuple_size, t_list_to_tuple, t_tuple_to_list, t_element, t_setelement, t_make_tuple_2, t_make_tuple_3, t_append_element, + t_insert_element, t_delete_element, tuple_with_case, tuple_in_guard]. groups() -> @@ -60,40 +62,40 @@ end_per_group(_GroupName, Config) -> build_and_match(Config) when is_list(Config) -> - ?line {} = id({}), - ?line {1} = id({1}), - ?line {1, 2} = id({1, 2}), - ?line {1, 2, 3} = id({1, 2, 3}), - ?line {1, 2, 3, 4} = id({1, 2, 3, 4}), - ?line {1, 2, 3, 4, 5} = id({1, 2, 3, 4, 5}), - ?line {1, 2, 3, 4, 5, 6} = id({1, 2, 3, 4, 5, 6}), - ?line {1, 2, 3, 4, 5, 6} = id({1, 2, 3, 4, 5, 6}), - ?line {1, 2, 3, 4, 5, 6, 7} = id({1, 2, 3, 4, 5, 6, 7}), - ?line {1, 2, 3, 4, 5, 6, 7, 8} = id({1, 2, 3, 4, 5, 6, 7, 8}), + {} = id({}), + {1} = id({1}), + {1, 2} = id({1, 2}), + {1, 2, 3} = id({1, 2, 3}), + {1, 2, 3, 4} = id({1, 2, 3, 4}), + {1, 2, 3, 4, 5} = id({1, 2, 3, 4, 5}), + {1, 2, 3, 4, 5, 6} = id({1, 2, 3, 4, 5, 6}), + {1, 2, 3, 4, 5, 6} = id({1, 2, 3, 4, 5, 6}), + {1, 2, 3, 4, 5, 6, 7} = id({1, 2, 3, 4, 5, 6, 7}), + {1, 2, 3, 4, 5, 6, 7, 8} = id({1, 2, 3, 4, 5, 6, 7, 8}), ok. %% Tests size(Tuple). t_size(Config) when is_list(Config) -> - ?line 0 = size({}), - ?line 1 = size({a}), - ?line 1 = size({{a}}), - ?line 2 = size({{a}, {b}}), - ?line 3 = size({1, 2, 3}), + 0 = size({}), + 1 = size({a}), + 1 = size({{a}}), + 2 = size({{a}, {b}}), + 3 = size({1, 2, 3}), ok. t_tuple_size(Config) when is_list(Config) -> - ?line 0 = tuple_size(id({})), - ?line 1 = tuple_size(id({a})), - ?line 1 = tuple_size(id({{a}})), - ?line 2 = tuple_size(id({{a},{b}})), - ?line 3 = tuple_size(id({1,2,3})), + 0 = tuple_size(id({})), + 1 = tuple_size(id({a})), + 1 = tuple_size(id({{a}})), + 2 = tuple_size(id({{a},{b}})), + 3 = tuple_size(id({1,2,3})), %% Error cases. - ?line {'EXIT',{badarg,_}} = (catch tuple_size([])), - ?line {'EXIT',{badarg,_}} = (catch tuple_size(<<1,2,3>>)), - ?line error = ludicrous_tuple_size({a,b,c}), - ?line error = ludicrous_tuple_size([a,b,c]), + {'EXIT',{badarg,_}} = (catch tuple_size([])), + {'EXIT',{badarg,_}} = (catch tuple_size(<<1,2,3>>)), + error = ludicrous_tuple_size({a,b,c}), + error = ludicrous_tuple_size([a,b,c]), ok. @@ -104,44 +106,44 @@ ludicrous_tuple_size(_) -> error. %% Tests element/2. t_element(Config) when is_list(Config) -> - ?line a = element(1, {a}), - ?line a = element(1, {a, b}), + a = element(1, {a}), + a = element(1, {a, b}), - ?line List = lists:seq(1, 4096), - ?line Tuple = list_to_tuple(lists:seq(1, 4096)), - ?line get_elements(List, Tuple, 1), + List = lists:seq(1, 4096), + Tuple = list_to_tuple(lists:seq(1, 4096)), + get_elements(List, Tuple, 1), - ?line {'EXIT', {badarg, _}} = (catch element(0, id({a,b}))), - ?line {'EXIT', {badarg, _}} = (catch element(3, id({a,b}))), - ?line {'EXIT', {badarg, _}} = (catch element(1, id({}))), - ?line {'EXIT', {badarg, _}} = (catch element(1, id([a,b]))), - ?line {'EXIT', {badarg, _}} = (catch element(1, id(42))), - ?line {'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))), + {'EXIT', {badarg, _}} = (catch element(0, id({a,b}))), + {'EXIT', {badarg, _}} = (catch element(3, id({a,b}))), + {'EXIT', {badarg, _}} = (catch element(1, id({}))), + {'EXIT', {badarg, _}} = (catch element(1, id([a,b]))), + {'EXIT', {badarg, _}} = (catch element(1, id(42))), + {'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))), ok. get_elements([Element|Rest], Tuple, Pos) -> - ?line Element = element(Pos, Tuple), - ?line get_elements(Rest, Tuple, Pos+1); + Element = element(Pos, Tuple), + get_elements(Rest, Tuple, Pos+1); get_elements([], _Tuple, _Pos) -> ok. %% Tests set_element/3. t_setelement(Config) when is_list(Config) -> - ?line {x} = setelement(1, id({1}), x), - ?line {x,2} = setelement(1, id({1,2}), x), - ?line {1,x} = setelement(2, id({1,2}), x), + {x} = setelement(1, id({1}), x), + {x,2} = setelement(1, id({1,2}), x), + {1,x} = setelement(2, id({1,2}), x), - ?line Tuple = list_to_tuple(lists:duplicate(2048, x)), - ?line NewTuple = set_all_elements(Tuple, 1), - ?line NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), + Tuple = list_to_tuple(lists:duplicate(2048, x)), + NewTuple = set_all_elements(Tuple, 1), + NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), - ?line {'EXIT', {badarg, _}} = (catch setelement(0, {a, b}, x)), - ?line {'EXIT', {badarg, _}} = (catch setelement(3, {a, b}, x)), - ?line {'EXIT', {badarg, _}} = (catch setelement(1, {}, x)), - ?line {'EXIT', {badarg, _}} = (catch setelement(1, [a, b], x)), - ?line {'EXIT', {badarg, _}} = (catch setelement(1.5, {a, b}, x)), + {'EXIT', {badarg, _}} = (catch setelement(0, {a, b}, x)), + {'EXIT', {badarg, _}} = (catch setelement(3, {a, b}, x)), + {'EXIT', {badarg, _}} = (catch setelement(1, {}, x)), + {'EXIT', {badarg, _}} = (catch setelement(1, [a, b], x)), + {'EXIT', {badarg, _}} = (catch setelement(1.5, {a, b}, x)), %% Nested setelement with literals. AnotherTuple = id({0,0,a,b,c}), @@ -159,52 +161,68 @@ set_all_elements(Tuple, Pos) when Pos > size(Tuple) -> %% Tests list_to_tuple/1. t_list_to_tuple(Config) when is_list(Config) -> - ?line {} = list_to_tuple([]), - ?line {a} = list_to_tuple([a]), - ?line {a, b} = list_to_tuple([a, b]), - ?line {a, b, c} = list_to_tuple([a, b, c]), - ?line {a, b, c, d} = list_to_tuple([a, b, c, d]), - ?line {a, b, c, d, e} = list_to_tuple([a, b, c, d, e]), - - ?line Size = 4096, - ?line Tuple = list_to_tuple(lists:seq(1, Size)), - ?line Size = size(Tuple), - - ?line {'EXIT', {badarg, _}} = (catch list_to_tuple(id({a,b}))), - ?line {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), - ?line {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), - + {} = list_to_tuple([]), + {a} = list_to_tuple([a]), + {a, b} = list_to_tuple([a, b]), + {a, b, c} = list_to_tuple([a, b, c]), + {a, b, c, d} = list_to_tuple([a, b, c, d]), + {a, b, c, d, e} = list_to_tuple([a, b, c, d, e]), + + Size = 4096, + Tuple = list_to_tuple(lists:seq(1, Size)), + Size = size(Tuple), + + {'EXIT', {badarg, _}} = (catch list_to_tuple(id({a,b}))), + {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), + {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), + + % test upper boundry, 16777215 elements + MaxSize = 1 bsl 24 - 1, + MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), + MaxSize = size(MaxTuple), + + {'EXIT', {badarg,_}} = (catch list_to_tuple(lists:seq(1, 1 bsl 24))), ok. %% Tests tuple_to_list/1. t_tuple_to_list(Config) when is_list(Config) -> - ?line [] = tuple_to_list({}), - ?line [a] = tuple_to_list({a}), - ?line [a, b] = tuple_to_list({a, b}), - ?line [a, b, c] = tuple_to_list({a, b, c}), - ?line [a, b, c, d] = tuple_to_list({a, b, c, d}), - ?line [a, b, c, d] = tuple_to_list({a, b, c, d}), - - ?line Size = 4096, - ?line List = lists:seq(1, Size), - ?line Tuple = list_to_tuple(List), - ?line Size = size(Tuple), - ?line List = tuple_to_list(Tuple), - - ?line {'EXIT', {badarg,_}} = (catch tuple_to_list(id(a))), - ?line {'EXIT', {badarg,_}} = (catch tuple_to_list(id(42))), + [] = tuple_to_list({}), + [a] = tuple_to_list({a}), + [a, b] = tuple_to_list({a, b}), + [a, b, c] = tuple_to_list({a, b, c}), + [a, b, c, d] = tuple_to_list({a, b, c, d}), + [a, b, c, d] = tuple_to_list({a, b, c, d}), + + Size = 4096, + List = lists:seq(1, Size), + Tuple = list_to_tuple(List), + Size = size(Tuple), + List = tuple_to_list(Tuple), + + {'EXIT', {badarg,_}} = (catch tuple_to_list(id(a))), + {'EXIT', {badarg,_}} = (catch tuple_to_list(id(42))), ok. %% Tests the make_tuple/2 BIF. t_make_tuple_2(Config) when is_list(Config) -> - ?line t_make_tuple1([]), - ?line t_make_tuple1(42), - ?line t_make_tuple1(a), - ?line t_make_tuple1({}), - ?line t_make_tuple1({a}), - ?line t_make_tuple1(erlang:make_tuple(400, [])), + t_make_tuple1([]), + t_make_tuple1(42), + t_make_tuple1(a), + t_make_tuple1({}), + t_make_tuple1({a}), + t_make_tuple1(erlang:make_tuple(400, [])), + + % test upper boundry, 16777215 elements + t_make_tuple(1 bsl 24 - 1, a), + {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 24, a)), + + {'EXIT', {badarg,_}} = (catch erlang:make_tuple(-1, a)), + % 26 bits is the total header arity room (for now) + {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 26 + 3, a)), + % bignum + {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 65 + 3, a)), ok. t_make_tuple1(Element) -> @@ -222,29 +240,82 @@ t_make_tuple(Size, Element) -> %% Tests the erlang:make_tuple/3 BIF. t_make_tuple_3(Config) when is_list(Config) -> - ?line {} = erlang:make_tuple(0, def, []), - ?line {def} = erlang:make_tuple(1, def, []), - ?line {a} = erlang:make_tuple(1, def, [{1,a}]), - ?line {a,def,c,def,e} = erlang:make_tuple(5, def, [{5,e},{1,a},{3,c}]), - ?line {a,def,c,def,e} = erlang:make_tuple(5, def, - [{1,blurf},{5,e},{3,blurf}, - {1,a},{3,c}]), + {} = erlang:make_tuple(0, def, []), + {def} = erlang:make_tuple(1, def, []), + {a} = erlang:make_tuple(1, def, [{1,a}]), + + {a,def,c,def,e} = erlang:make_tuple(5, def, [{5,e},{1,a},{3,c}]), + {a,def,c,def,e} = erlang:make_tuple(5, def, [{1,blurf},{5,e},{3,blurf},{1,a},{3,c}]), + MaxSize = 1 bsl 16 - 1, + MaxTuple = erlang:make_tuple(MaxSize, def, [{1,blurf},{5,e},{3,blurf},{1,a},{3,c}]), + MaxSize = size(MaxTuple), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(0, def, [{1,a}])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{-1,a}])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{0,a}])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{6,z}])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(a, def, [{6,z}])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{1,a}|b])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [42])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [[a,b,c]])), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, non_list)), + {'EXIT',{badarg,_}} = (catch erlang:make_tuple(1 bsl 24, def, [{5,e},{1,a},{3,c}])), + + ok. + +%% Tests the erlang:insert_element/3 BIF. +t_insert_element(Config) when is_list(Config) -> + {a} = erlang:insert_element(1, {}, a), + {{b,b},a} = erlang:insert_element(1, {a}, {b,b}), + {a,b} = erlang:insert_element(2, {a}, b), + [b,def|_] = tuple_to_list(erlang:insert_element(1, erlang:make_tuple(1 bsl 20, def), b)), + [def,b|_] = tuple_to_list(erlang:insert_element(2, erlang:make_tuple(1 bsl 20, def), b)), + [def,b|_] = lists:reverse(tuple_to_list(erlang:insert_element(1 bsl 20, erlang:make_tuple(1 bsl 20, def), b))), + [b,def|_] = lists:reverse(tuple_to_list(erlang:insert_element((1 bsl 20) + 1, erlang:make_tuple(1 bsl 20, def), b))), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch erlang:insert_element(1, [], a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(1, a, a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(0, {}, a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(0, {b,b,b,b,b}, a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(-1, {}, a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(2, {}, a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(6, {b,b,b,b}, a)), + {'EXIT',{badarg,_}} = (catch erlang:insert_element(1 bsl 20, {b,b,b,b}, a)), + ok. + +%% Tests the erlang:delete_element/3 BIF. +t_delete_element(Config) when is_list(Config) -> + {} = erlang:delete_element(1, {a}), + {{b,b},c} = erlang:delete_element(1, {a,{b,b},c}), + {a,b} = erlang:delete_element(2, {a,c,b}), + [2,3|_] = tuple_to_list(erlang:delete_element(1, list_to_tuple(lists:seq(1, 1 bsl 20)))), + [1,3|_] = tuple_to_list(erlang:delete_element(2, list_to_tuple(lists:seq(1, 1 bsl 20)))), + [(1 bsl 20) - 1, (1 bsl 20) - 2 |_] = lists:reverse(tuple_to_list(erlang:delete_element(1 bsl 20, list_to_tuple(lists:seq(1, 1 bsl 20))))), + [(1 bsl 20), (1 bsl 20) - 2 |_] = lists:reverse(tuple_to_list(erlang:delete_element((1 bsl 20) - 1, list_to_tuple(lists:seq(1, 1 bsl 20))))), %% Error cases. - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(0, def, [{1,a}])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{-1,a}])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{0,a}])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{6,z}])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(a, def, [{6,z}])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{1,a}|b])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [42])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [[a,b,c]])), - ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, non_list)), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(1, [])), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(1, a)), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(0, {})), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(-1, {})), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(1, {})), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(0, {b,b,b,b,b})), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(5, {b,b,b,b})), + {'EXIT',{badarg,_}} = (catch erlang:delete_element(1 bsl 20, {b,c,b,b,b})), ok. + %% Tests the append_element/2 BIF. t_append_element(Config) when is_list(Config) -> - t_append_element({}, 2048, 2048). + ok = t_append_element({}, 2048, 2048), + + % test upper boundry, 16777215 elements + MaxSize = 1 bsl 24 - 1, + MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), + {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)), + ok. t_append_element(_Tuple, 0, _High) -> ok; t_append_element(Tuple, N, High) -> @@ -261,7 +332,7 @@ verify_seq([High|T], High, Lower) -> %% (This is known to crash earlier versions of BEAM.) tuple_with_case(Config) when is_list(Config) -> - ?line {reply, true} = tuple_with_case(), + {reply, true} = tuple_with_case(), ok. tuple_with_case() -> @@ -280,21 +351,21 @@ foo() -> ignored. %% Test to build a tuple in a guard. tuple_in_guard(Config) when is_list(Config) -> - ?line Tuple1 = id({a,b}), - ?line Tuple2 = id({a,b,c}), - ?line if - Tuple1 == {element(1, Tuple2),element(2, Tuple2)} -> - ok; - true -> - ?line test_server:fail() - end, - ?line if - Tuple2 == {element(1, Tuple2),element(2, Tuple2), - element(3, Tuple2)} -> - ok; - true -> - ?line test_server:fail() - end, + Tuple1 = id({a,b}), + Tuple2 = id({a,b,c}), + if + Tuple1 == {element(1, Tuple2),element(2, Tuple2)} -> + ok; + true -> + test_server:fail() + end, + if + Tuple2 == {element(1, Tuple2),element(2, Tuple2), + element(3, Tuple2)} -> + ok; + true -> + test_server:fail() + end, ok. %% Use this function to avoid compile-time evaluation of an expression. diff --git a/erts/emulator/zlib/zlib.mk b/erts/emulator/zlib/zlib.mk index fa1f159fae..ff5ffa5328 100644 --- a/erts/emulator/zlib/zlib.mk +++ b/erts/emulator/zlib/zlib.mk @@ -63,12 +63,12 @@ endif # gcov ifeq ($(TARGET), win32) $(ZLIB_LIBRARY): $(ZLIB_OBJS) - $(AR) -out:$@ $(ZLIB_OBJS) + $(V_AR) -out:$@ $(ZLIB_OBJS) else $(ZLIB_LIBRARY): $(ZLIB_OBJS) - $(AR) $(ARFLAGS) $@ $(ZLIB_OBJS) + $(V_AR) $(ARFLAGS) $@ $(ZLIB_OBJS) -@ ($(RANLIB) $@ || true) 2>/dev/null endif $(ZLIB_OBJDIR)/%.o: zlib/%.c - $(CC) -c $(ZLIB_CFLAGS) -o $@ $< + $(V_CC) -c $(ZLIB_CFLAGS) -o $@ $< |