aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/Makefile.in46
-rw-r--r--erts/emulator/beam/atom.names2
-rw-r--r--erts/emulator/beam/beam_bif_load.c96
-rw-r--r--erts/emulator/beam/beam_bp.c20
-rw-r--r--erts/emulator/beam/beam_bp.h17
-rw-r--r--erts/emulator/beam/beam_catches.c46
-rw-r--r--erts/emulator/beam/beam_debug.c27
-rw-r--r--erts/emulator/beam/beam_emu.c630
-rw-r--r--erts/emulator/beam/beam_load.c1440
-rw-r--r--erts/emulator/beam/beam_load.h15
-rw-r--r--erts/emulator/beam/bif.c189
-rw-r--r--erts/emulator/beam/bif.h155
-rw-r--r--erts/emulator/beam/big.c68
-rw-r--r--erts/emulator/beam/big.h1
-rw-r--r--erts/emulator/beam/binary.c10
-rw-r--r--erts/emulator/beam/break.c2
-rw-r--r--erts/emulator/beam/copy.c2
-rw-r--r--erts/emulator/beam/dist.c53
-rw-r--r--erts/emulator/beam/erl_alloc.c18
-rw-r--r--erts/emulator/beam/erl_arith.c8
-rw-r--r--erts/emulator/beam/erl_bif_binary.c78
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c137
-rw-r--r--erts/emulator/beam/erl_bif_info.c263
-rw-r--r--erts/emulator/beam/erl_bif_lists.c104
-rw-r--r--erts/emulator/beam/erl_bif_op.c25
-rw-r--r--erts/emulator/beam/erl_bif_os.c24
-rw-r--r--erts/emulator/beam/erl_bif_port.c75
-rw-r--r--erts/emulator/beam/erl_bif_re.c135
-rw-r--r--erts/emulator/beam/erl_bif_trace.c103
-rw-r--r--erts/emulator/beam/erl_bits.c12
-rw-r--r--erts/emulator/beam/erl_db.c166
-rw-r--r--erts/emulator/beam/erl_db_hash.c24
-rw-r--r--erts/emulator/beam/erl_db_hash.h3
-rw-r--r--erts/emulator/beam/erl_db_tree.c10
-rw-r--r--erts/emulator/beam/erl_db_util.c48
-rw-r--r--erts/emulator/beam/erl_db_util.h6
-rw-r--r--erts/emulator/beam/erl_gc.c54
-rw-r--r--erts/emulator/beam/erl_init.c34
-rw-r--r--erts/emulator/beam/erl_message.c4
-rw-r--r--erts/emulator/beam/erl_monitors.c8
-rw-r--r--erts/emulator/beam/erl_nif.c66
-rw-r--r--erts/emulator/beam/erl_nif.h3
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h202
-rw-r--r--erts/emulator/beam/erl_process.c30
-rw-r--r--erts/emulator/beam/erl_process.h15
-rw-r--r--erts/emulator/beam/erl_process_lock.c18
-rw-r--r--erts/emulator/beam/erl_term.h8
-rw-r--r--erts/emulator/beam/erl_trace.c13
-rw-r--r--erts/emulator/beam/erl_unicode.c52
-rw-r--r--erts/emulator/beam/erl_vm.h2
-rw-r--r--erts/emulator/beam/external.c59
-rw-r--r--erts/emulator/beam/external.h4
-rw-r--r--erts/emulator/beam/global.h38
-rw-r--r--erts/emulator/beam/io.c6
-rw-r--r--erts/emulator/beam/ops.tab176
-rw-r--r--erts/emulator/beam/sys.h9
-rw-r--r--erts/emulator/beam/utils.c116
-rw-r--r--erts/emulator/drivers/common/efile_drv.c186
-rw-r--r--erts/emulator/drivers/common/inet_drv.c774
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c3
-rw-r--r--[-rwxr-xr-x]erts/emulator/drivers/win32/win_efile.c0
-rw-r--r--erts/emulator/hipe/hipe_abi.txt2
-rw-r--r--erts/emulator/hipe/hipe_amd64_bifs.m453
-rw-r--r--erts/emulator/hipe/hipe_amd64_primops.h2
-rw-r--r--erts/emulator/hipe/hipe_arm_bifs.m439
-rw-r--r--erts/emulator/hipe/hipe_bif0.c20
-rw-r--r--erts/emulator/hipe/hipe_bif0.h2
-rw-r--r--erts/emulator/hipe/hipe_bif0.tab2
-rw-r--r--erts/emulator/hipe/hipe_bif2.c23
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m429
-rw-r--r--erts/emulator/hipe/hipe_mkliterals.c90
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c45
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c47
-rw-r--r--erts/emulator/hipe/hipe_native_bif.h22
-rw-r--r--erts/emulator/hipe/hipe_ppc_asm.m411
-rw-r--r--erts/emulator/hipe/hipe_ppc_bifs.m459
-rw-r--r--erts/emulator/hipe/hipe_primops.h4
-rw-r--r--erts/emulator/hipe/hipe_process.h6
-rw-r--r--erts/emulator/hipe/hipe_risc_glue.h16
-rw-r--r--erts/emulator/hipe/hipe_sparc_bifs.m465
-rw-r--r--erts/emulator/hipe/hipe_x86.h2
-rw-r--r--erts/emulator/hipe/hipe_x86_bifs.m457
-rw-r--r--erts/emulator/hipe/hipe_x86_glue.h19
-rw-r--r--erts/emulator/hipe/hipe_x86_primops.h3
-rw-r--r--erts/emulator/pcre/Makefile26
-rw-r--r--erts/emulator/pcre/Makefile.in165
-rw-r--r--erts/emulator/pcre/pcre.mk113
-rw-r--r--erts/emulator/sys/common/erl_mseg.c14
-rw-r--r--erts/emulator/sys/unix/sys.c21
-rw-r--r--erts/emulator/sys/vxworks/sys.c3
-rw-r--r--erts/emulator/test/Makefile2
-rw-r--r--erts/emulator/test/big_SUITE.erl15
-rw-r--r--erts/emulator/test/binary_SUITE.erl41
-rw-r--r--erts/emulator/test/bs_match_misc_SUITE.erl14
-rw-r--r--erts/emulator/test/bs_utf_SUITE.erl12
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl26
-rw-r--r--erts/emulator/test/code_SUITE.erl164
-rw-r--r--erts/emulator/test/code_SUITE_data/fun_confusion.erl31
-rw-r--r--erts/emulator/test/code_SUITE_data/literals.erl21
-rw-r--r--erts/emulator/test/distribution_SUITE.erl14
-rw-r--r--erts/emulator/test/exception_SUITE.erl246
-rw-r--r--erts/emulator/test/float_SUITE.erl126
-rw-r--r--erts/emulator/test/fun_r13_SUITE.erl (renamed from erts/emulator/test/fun_r12_SUITE.erl)10
-rw-r--r--erts/emulator/test/guard_SUITE.erl8
-rw-r--r--erts/emulator/test/nif_SUITE.erl56
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c36
-rw-r--r--erts/emulator/test/process_SUITE.erl99
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl32
-rwxr-xr-xerts/emulator/utils/beam_makeops188
-rwxr-xr-xerts/emulator/utils/make_preload1
-rwxr-xr-xerts/emulator/utils/make_tables39
-rw-r--r--erts/emulator/valgrind/suppress.patched.3.6.0350
-rw-r--r--erts/emulator/valgrind/suppress.standard308
113 files changed, 5975 insertions, 2762 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 15244a6589..289d5e2a9d 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -291,7 +291,8 @@ else
LIBS += $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX)
endif
-DEPLIBS += $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX)
+EPCRE_LIB = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/$(LIB_PREFIX)epcre$(LIB_SUFFIX)
+DEPLIBS += $(EPCRE_LIB)
PERFCTR_PATH=@PERFCTR_PATH@
USE_PERFCTR=@USE_PERFCTR@
@@ -358,7 +359,6 @@ ERLANG_OSTYPE = @ERLANG_OSTYPE@
ENABLE_ALLOC_TYPE_VARS += @ERLANG_OSTYPE@
-EMULATOR_EXECUTABLE_ELIB = beam.elib$(TF_MARKER)
ifeq ($(TARGET), win32)
EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll
else
@@ -382,7 +382,7 @@ ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no)
all:
@echo '*** Omitted build of emulator with smp support'
else
-all: generate erts_lib zlib pcre $(BINDIR)/$(EMULATOR_EXECUTABLE) $(UNIX_ONLY_BUILDS)
+all: generate erts_lib zlib $(BINDIR)/$(EMULATOR_EXECUTABLE) $(UNIX_ONLY_BUILDS)
ifeq ($(OMIT_OMIT_FP),yes)
@echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
@echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *'
@@ -403,8 +403,8 @@ zlib:
@set -e ; cd zlib && $(MAKE) TYPE=$(TYPE) $(TYPE)
endif
-pcre:
- @set -e ; cd pcre && $(MAKE) TYPE=$(TYPE) $(TYPE)
+
+include pcre/pcre.mk
erts_lib:
cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE)
@@ -420,9 +420,9 @@ endif
$(RM) -rf $(BINDIR)/child_setup $(BINDIR)/child_setup.*
$(RM) -f $(BINDIR)/hipe_mkliterals $(BINDIR)/hipe_mkliterals.*
@set -e ; cd zlib && $(MAKE) clean
- @set -e ; cd pcre && $(MAKE) clean
+ rm -f $(OBJS) $(OBJDIR)/libepcre.a
-.PHONY: all zlib pcre clean
+.PHONY: all zlib clean
docs:
@@ -467,10 +467,11 @@ release_docs_spec:
# Generated source code. Put in $(TARGET) directory
#
+_create_dirs := $(shell mkdir -p $(CREATE_DIRS))
+
.PHONY : generate
-GENERATE= $(CREATE_DIRS) \
- $(TTF_DIR)/beam_opcodes.h \
+GENERATE= $(TTF_DIR)/beam_opcodes.h \
$(TARGET)/erl_bif_table.c \
$(TARGET)/erl_version.h \
$(TTF_DIR)/driver_tab.c \
@@ -672,14 +673,8 @@ endif
# rebuilding (is this a good idea?) add a dummy dependency to this target.
#
-ifeq ($(findstring clearmake,$(MAKE)),clearmake)
-BEAMFILE_MAKEFLAG=-T
-else
-BEAMFILE_MAKEFLAG=
-endif
-
$(ERL_TOP)/lib/%.beam:
- cd $(@D)/../src && $(MAKE) $(BEAMFILE_MAKEFLAG) ../ebin/$(@F)
+ cd $(@D)/../src && $(MAKE) ../ebin/$(@F)
# ----------------------------------------------------------------------
@@ -858,7 +853,7 @@ $(OBJDIR)/%.o: hipe/%.c
$(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o
$(CC) $(CFLAGS) $(INCLUDES) -o $@ $<
-$(OBJDIR)/hipe_mkliterals.o: $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_ppc_asm.h
+$(OBJDIR)/hipe_mkliterals.o: $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_ppc_asm.h $(TTF_DIR)/beam_opcodes.h
$(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER)
$(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@
@@ -946,7 +941,6 @@ $(TARGET)/Makefile: Makefile.in
#SED_REPL_WIN_DRIVE=s|\([ ]\)\([A-Za-z]\):|\1/cygdrive/\2|g;s|^\([A-Za-z]\):|/cygdrive/\1|g
SED_REPL_O=s|^\([^:]*:\)|$$(OBJDIR)/\1|g
-SED_REPL_ELIB_O=s|^\([^:]*\).o[ ]*:|$$(OBJDIR)/\1.elib.o:|g
SED_REPL_TTF_DIR=s|$(TTF_DIR)/|$$(TTF_DIR)/|g
SED_REPL_ERL_TOP=s|\([ ]\)$(ERL_TOP)/|\1$$(ERL_TOP)/|g;s|^$(ERL_TOP)/|$$(ERL_TOP)/|g
SED_REPL_POLL=s|$$(OBJDIR)/erl_poll.o|$$(OBJDIR)/erl_poll.kp.o $$(OBJDIR)/erl_poll.nkp.o|g
@@ -966,7 +960,6 @@ SED_SUFFIX=
endif
SED_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_O);$(SED_REPL_TTF_DIR);$(SED_REPL_ERL_TOP)$(SED_SUFFIX)'
-SED_ELIB_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_ELIB_O);$(SED_REPL_TTF_DIR);$(SED_REPL_ERL_TOP)$(SED_SUFFIX)'
ifdef HIPE_ENABLED
HIPE_SRC=$(wildcard hipe/*.c)
@@ -975,7 +968,8 @@ HIPE_SRC=
endif
BEAM_SRC=$(wildcard beam/*.c)
-DRV_SRC=$(wildcard drivers/common/*.c) $(wildcard drivers/$(ERLANG_OSTYPE)/*.c)
+DRV_COMMON_SRC=$(wildcard drivers/common/*.c)
+DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c)
ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c)
TARGET_SRC=$(wildcard $(TARGET)/*.c) $(wildcard $(TTF_DIR)/*.c)
@@ -986,7 +980,7 @@ ifeq ($(TARGET),win32)
#DEP_CC=$(EMU_CC)
DEP_CC=$(CC)
-DEP_FLAGS=-MM $(subst -O2,,$(CFLAGS)) $(INCLUDES) -I../etc/win32 -Idrivers/common
+DEP_FLAGS=-MM $(subst -O2,,$(CFLAGS)) $(INCLUDES) -I../etc/win32 -Idrivers/common -Idrivers/$(ERLANG_OSTYPE)
# ifeq (@MIXED_CYGWIN_VC@,yes)
# VC++ used for compiling. If __GNUC__ is defined we will include
# other headers then when compiling which will result in faulty
@@ -1006,23 +1000,21 @@ MG_FLAG=-MG
endif
DEP_CC=$(CC)
-DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Idrivers/common
+DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE)
SYS_SRC=$(ALL_SYS_SRC)
endif
depend:
$(DEP_CC) $(DEP_FLAGS) $(BEAM_SRC) \
| $(SED_DEPEND) > $(TARGET)/depend.mk
- $(DEP_CC) $(DEP_FLAGS) $(DRV_SRC) \
+ $(DEP_CC) $(DEP_FLAGS) -DLIBSCTP=$(LIBSCTP) $(DRV_COMMON_SRC) \
+ | $(SED_DEPEND) >> $(TARGET)/depend.mk
+ $(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \
| $(SED_DEPEND) >> $(TARGET)/depend.mk
$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \
| $(SED_DEPEND) >> $(TARGET)/depend.mk
$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \
| $(SED_DEPEND) >> $(TARGET)/depend.mk
-ifneq ($(TARGET),win32)
- $(DEP_CC) $(DEP_FLAGS) $(ELIB_C_FILES) \
- | $(SED_ELIB_DEPEND) >> $(TARGET)/depend.mk
-endif
ifdef HIPE_ENABLED
$(DEP_CC) $(DEP_FLAGS) $(HIPE_SRC) \
| $(SED_DEPEND) >> $(TARGET)/depend.mk
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 37738faae3..71454b3e57 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -158,6 +158,8 @@ atom cr
atom crlf
atom creation
atom current_function
+atom current_location
+atom current_stacktrace
atom data
atom debug_flags
atom delay_trap
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index e6dba10fde..bc8c001454 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -40,6 +40,7 @@ static Eterm check_process_code(Process* rp, Module* modp);
static void delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp);
static void delete_export_references(Eterm module);
static int purge_module(int module);
+static void decrement_refc(BeamInstr* code);
static int is_native(BeamInstr* code);
static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -50,11 +51,11 @@ load_module_2(BIF_ALIST_2)
{
Eterm reason;
Eterm* hp;
- int i;
int sz;
byte* code;
Eterm res;
byte* temp_alloc = NULL;
+ struct LoaderState* stp;
if (is_not_atom(BIF_ARG_1)) {
error:
@@ -64,49 +65,37 @@ load_module_2(BIF_ALIST_2)
if ((code = erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc)) == NULL) {
goto error;
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
-
- erts_export_consolidate();
-
hp = HAlloc(BIF_P, 3);
+
+ /*
+ * Read the BEAM file and prepare the module for loading.
+ */
+ stp = erts_alloc_loader_state();
sz = binary_size(BIF_ARG_2);
- if ((i = erts_load_module(BIF_P, 0,
- BIF_P->group_leader, &BIF_ARG_1, code, sz)) < 0) {
- switch (i) {
- case -1: reason = am_badfile; break;
- case -2: reason = am_nofile; break;
- case -3: reason = am_not_purged; break;
- case -4:
- reason = am_atom_put("native_code", sizeof("native_code")-1);
- break;
- case -5:
- {
- /*
- * The module contains an on_load function. The loader
- * has loaded the module as usual, except that the
- * export entries does not point into the module, so it
- * is not possible to call any code in the module.
- */
-
- ERTS_DECL_AM(on_load);
- reason = AM_on_load;
- break;
- }
- default: reason = am_badfile; break;
- }
+ reason = erts_prepare_loading(stp, BIF_P, BIF_P->group_leader,
+ &BIF_ARG_1, code, sz);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ if (reason != NIL) {
res = TUPLE2(hp, am_error, reason);
- goto done;
+ BIF_RET(res);
}
- set_default_trace_pattern(BIF_ARG_1);
- res = TUPLE2(hp, am_module, BIF_ARG_1);
+ /*
+ * Stop all other processes and finish the loading of the module.
+ */
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_thr_progress_block();
+
+ reason = erts_finish_loading(stp, BIF_P, 0, &BIF_ARG_1);
+ if (reason != NIL) {
+ res = TUPLE2(hp, am_error, reason);
+ } else {
+ set_default_trace_pattern(BIF_ARG_1);
+ res = TUPLE2(hp, am_module, BIF_ARG_1);
+ }
- done:
- erts_free_aligned_binary_bytes(temp_alloc);
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
-
BIF_RET(res);
}
@@ -565,6 +554,7 @@ check_process_code(Process* rp, Module* modp)
} else {
Eterm* literals;
Uint lit_size;
+ struct erl_off_heap_header* oh;
/*
* Try to get rid of constants by by garbage collecting.
@@ -578,7 +568,9 @@ check_process_code(Process* rp, Module* modp)
(void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
literals = (Eterm *) modp->old_code[MI_LITERALS_START];
lit_size = (Eterm *) modp->old_code[MI_LITERALS_END] - literals;
- erts_garbage_collect_literals(rp, literals, lit_size);
+ oh = (struct erl_off_heap_header *)
+ modp->old_code[MI_LITERALS_OFF_HEAP];
+ erts_garbage_collect_literals(rp, literals, lit_size, oh);
}
}
return am_false;
@@ -656,9 +648,6 @@ purge_module(int module)
* Any code to purge?
*/
if (modp->old_code == 0) {
- if (display_loads) {
- erts_printf("No code to purge for %T\n", make_atom(module));
- }
return -1;
}
@@ -679,6 +668,7 @@ purge_module(int module)
end = (BeamInstr *)((char *)code + modp->old_code_length);
erts_cleanup_funs_on_purge(code, end);
beam_catches_delmod(modp->old_catches, code, modp->old_code_length);
+ decrement_refc(code);
erts_free(ERTS_ALC_T_CODE, (void *) code);
modp->old_code = NULL;
modp->old_code_length = 0;
@@ -688,6 +678,23 @@ purge_module(int module)
}
static void
+decrement_refc(BeamInstr* code)
+{
+ struct erl_off_heap_header* oh =
+ (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
+
+ while (oh) {
+ Binary* bptr;
+ ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
+ bptr = ((ProcBin*)oh)->val;
+ if (erts_refc_dectest(&bptr->refc, 0) == 0) {
+ erts_bin_free(bptr);
+ }
+ oh = oh->next;
+ }
+}
+
+static void
remove_from_address_table(BeamInstr* code)
{
int i;
@@ -774,7 +781,7 @@ delete_export_references(Eterm module)
}
-int
+Eterm
beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
{
Module* modp = erts_put_module(module);
@@ -785,15 +792,12 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
*/
if (modp->code != NULL && modp->old_code != NULL) {
- return -3;
+ return am_not_purged;
} else if (modp->old_code == NULL) { /* Make the current version old. */
- if (display_loads) {
- erts_printf("saving old code\n");
- }
delete_code(c_p, c_p_locks, modp);
delete_export_references(module);
}
- return 0;
+ return NIL;
}
static int
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 67748698e1..692fa61fe8 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -495,16 +495,6 @@ erts_find_local_func(Eterm mfa[3]) {
return NULL;
}
-/* bp_hash */
-ERTS_INLINE Uint bp_sched2ix() {
-#ifdef ERTS_SMP
- ErtsSchedulerData *esdp;
- esdp = erts_get_scheduler_data();
- return esdp->no - 1;
-#else
- return 0;
-#endif
-}
static void bp_hash_init(bp_time_hash_t *hash, Uint n) {
Uint size = sizeof(bp_data_time_item_t)*n;
Uint i;
@@ -612,9 +602,13 @@ static void bp_hash_delete(bp_time_hash_t *hash) {
static void bp_time_diff(bp_data_time_item_t *item, /* out */
process_breakpoint_time_t *pbt, /* in */
Uint ms, Uint s, Uint us) {
- int dms,ds,dus;
+ int ds,dus;
+#ifdef DEBUG
+ int dms;
+
dms = ms - pbt->ms;
+#endif
ds = s - pbt->s;
dus = us - pbt->us;
@@ -622,7 +616,9 @@ static void bp_time_diff(bp_data_time_item_t *item, /* out */
* this is ok.
*/
+#ifdef DEBUG
ASSERT(dms >= 0 || ds >= 0 || dus >= 0);
+#endif
if (dus < 0) {
dus += 1000000;
@@ -1341,7 +1337,7 @@ static BpData *is_break(BeamInstr *pc, BeamInstr break_op) {
return NULL;
}
- bd = ebd = rs[bp_sched2ix()];
+ bd = ebd = rs[erts_bp_sched2ix()];
ASSERT(bd);
if ( (break_op == 0) || (bd->this_instr == break_op)) {
return bd;
diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h
index 2ec5818688..167069552f 100644
--- a/erts/emulator/beam/beam_bp.h
+++ b/erts/emulator/beam/beam_bp.h
@@ -144,8 +144,6 @@ extern erts_smp_spinlock_t erts_bp_lock;
#define ErtsSmpBPUnlock(BDC)
#endif
-ERTS_INLINE Uint bp_sched2ix(void);
-
#ifdef ERTS_SMP
#define bp_sched2ix_proc(p) ((p)->scheduler_data->no - 1)
#else
@@ -247,4 +245,19 @@ BpData *erts_get_time_break(Process *p, BeamInstr *pc);
BeamInstr *erts_find_local_func(Eterm mfa[3]);
+ERTS_GLB_INLINE Uint erts_bp_sched2ix(void);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Uint erts_bp_sched2ix(void)
+{
+#ifdef ERTS_SMP
+ ErtsSchedulerData *esdp;
+ esdp = erts_get_scheduler_data();
+ return esdp->no - 1;
+#else
+ return 0;
+#endif
+}
+#endif
+
#endif /* _BEAM_BP_H */
diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c
index e795b4efbd..a550ec5ad0 100644
--- a/erts/emulator/beam/beam_catches.c
+++ b/erts/emulator/beam/beam_catches.c
@@ -22,21 +22,27 @@
#endif
#include "sys.h"
#include "beam_catches.h"
+#include "global.h"
-/* XXX: should use dynamic reallocation */
-#define TABSIZ (16*1024)
-static struct {
+/* R14B04 has about 380 catches when starting erlang */
+#define DEFAULT_TABSIZE (1024)
+typedef struct {
BeamInstr *cp;
unsigned cdr;
-} beam_catches[TABSIZ];
+} beam_catch_t;
static int free_list;
static unsigned high_mark;
+static unsigned tabsize;
+static beam_catch_t *beam_catches;
void beam_catches_init(void)
{
+ tabsize = DEFAULT_TABSIZE;
free_list = -1;
high_mark = 0;
+
+ beam_catches = erts_alloc(ERTS_ALC_T_CODE, sizeof(beam_catch_t)*DEFAULT_TABSIZE);
}
unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
@@ -50,16 +56,21 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
* This avoids the need to initialise the free list in
* beam_catches_init(), which would cost O(TABSIZ) time.
*/
- if( (i = free_list) >= 0 ) {
+ if( free_list >= 0 ) {
+ i = free_list;
free_list = beam_catches[i].cdr;
- } else if( (i = high_mark) < TABSIZ ) {
- high_mark = i + 1;
+ } else if( high_mark < tabsize ) {
+ i = high_mark;
+ high_mark++;
} else {
- fprintf(stderr, "beam_catches_cons: no free slots :-(\r\n");
- exit(1);
+ /* No free slots and table is full: realloc table */
+ tabsize = 2*tabsize;
+ beam_catches = erts_realloc(ERTS_ALC_T_CODE, beam_catches, sizeof(beam_catch_t)*tabsize);
+ i = high_mark;
+ high_mark++;
}
- beam_catches[i].cp = cp;
+ beam_catches[i].cp = cp;
beam_catches[i].cdr = cdr;
return i;
@@ -67,10 +78,8 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
BeamInstr *beam_catches_car(unsigned i)
{
- if( i >= TABSIZ ) {
- fprintf(stderr,
- "beam_catches_car: index %#x is out of range\r\n", i);
- abort();
+ if( i >= tabsize ) {
+ erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
return beam_catches[i].cp;
}
@@ -80,18 +89,15 @@ void beam_catches_delmod(unsigned head, BeamInstr *code, unsigned code_bytes)
unsigned i, cdr;
for(i = head; i != (unsigned)-1;) {
- if( i >= TABSIZ ) {
- fprintf(stderr,
- "beam_catches_delmod: index %#x is out of range\r\n", i);
- abort();
+ if( i >= tabsize ) {
+ erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
if( (char*)beam_catches[i].cp - (char*)code >= code_bytes ) {
- fprintf(stderr,
+ erl_exit(1,
"beam_catches_delmod: item %#x has cp %#lx which is not "
"in module's range [%#lx,%#lx[\r\n",
i, (long)beam_catches[i].cp,
(long)code, (long)((char*)code + code_bytes));
- abort();
}
beam_catches[i].cp = 0;
cdr = beam_catches[i].cdr;
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 2b4448f93b..8041c92162 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -50,15 +50,18 @@ void dbg_bt(Process* p, Eterm* sp);
void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg);
static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr);
-Eterm
-erts_debug_same_2(Process* p, Eterm term1, Eterm term2)
+
+BIF_RETTYPE
+erts_debug_same_2(BIF_ALIST_2)
{
- return (term1 == term2) ? am_true : am_false;
+ return (BIF_ARG_1 == BIF_ARG_2) ? am_true : am_false;
}
-Eterm
-erts_debug_flat_size_1(Process* p, Eterm term)
+BIF_RETTYPE
+erts_debug_flat_size_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm term = BIF_ARG_1;
Uint size = size_object(term);
if (IS_USMALL(0, size)) {
@@ -69,9 +72,13 @@ erts_debug_flat_size_1(Process* p, Eterm term)
}
}
-Eterm
-erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool)
+
+BIF_RETTYPE
+erts_debug_breakpoint_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm MFA = BIF_ARG_1;
+ Eterm bool = BIF_ARG_2;
Eterm* tp;
Eterm mfa[3];
int i;
@@ -176,9 +183,11 @@ erts_debug_instructions_0(BIF_ALIST_0)
return res;
}
-Eterm
-erts_debug_disassemble_1(Process* p, Eterm addr)
+BIF_RETTYPE
+erts_debug_disassemble_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm addr = BIF_ARG_1;
erts_dsprintf_buf_t *dsbufp;
Eterm* hp;
Eterm* tp;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 73c9fdc5d7..c65b2be106 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -45,7 +45,7 @@
/* #define HARDDEBUG 1 */
#if defined(NO_JUMP_TABLE)
-# define OpCase(OpCode) case op_##OpCode: lb_##OpCode
+# define OpCase(OpCode) case op_##OpCode
# define CountCase(OpCode) case op_count_##OpCode
# define OpCode(OpCode) ((Uint*)op_##OpCode)
# define Goto(Rel) {Go = (int)(Rel); goto emulator_loop;}
@@ -53,7 +53,7 @@
#else
# define OpCase(OpCode) lb_##OpCode
# define CountCase(OpCode) lb_count_##OpCode
-# define Goto(Rel) goto *(Rel)
+# define Goto(Rel) goto *((void *)Rel)
# define LabelAddr(Label) &&Label
# define OpCode(OpCode) (&&lb_##OpCode)
#endif
@@ -199,7 +199,7 @@ do { \
} \
} while (0)
-#define ClauseFail() goto lb_jump_f
+#define ClauseFail() goto jump_f
#define SAVE_CP(X) \
do { \
@@ -234,6 +234,12 @@ BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */
BeamInstr beam_exception_trace[1]; /* UGLY also OpCode(i_return_trace) */
BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
+
+/*
+ * We should warn only once for tuple funs.
+ */
+static erts_smp_atomic_t warned_for_tuple_funs;
+
/*
* All Beam instructions in numerical order.
*/
@@ -304,44 +310,6 @@ extern int count_instructions;
PROCESS_MAIN_CHK_LOCKS((P)); \
ERTS_SMP_UNREQ_PROC_MAIN_LOCK((P))
-#if defined(HYBRID)
-# define POST_BIF_GC_SWAPIN_0(_p, _res) \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \
- } \
- SWAPIN
-
-# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _regs[0] = r(0); \
- _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \
- r(0) = _regs[0]; \
- } \
- SWAPIN
-#else
-# define POST_BIF_GC_SWAPIN_0(_p, _res) \
- ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \
- PROCESS_MAIN_CHK_LOCKS((_p)); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \
- E = (_p)->stop; \
- } \
- HTOP = HEAP_TOP((_p))
-
-# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \
- ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \
- PROCESS_MAIN_CHK_LOCKS((_p)); \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _regs[0] = r(0); \
- _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \
- r(0) = _regs[0]; \
- E = (_p)->stop; \
- } \
- HTOP = HEAP_TOP((_p))
-#endif
-
#define db(N) (N)
#define tb(N) (N)
#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
@@ -795,11 +763,11 @@ extern int count_instructions;
} \
} while (0)
-#define IsFunction2(F, A, Action) \
- do { \
- if (is_function_2(c_p, F, A) != am_true ) {\
- Action; \
- } \
+#define IsFunction2(F, A, Action) \
+ do { \
+ if (erl_is_function(c_p, F, A) != am_true ) { \
+ Action; \
+ } \
} while (0)
#define IsTupleOfArity(Src, Arity, Fail) \
@@ -1053,6 +1021,7 @@ init_emulator(void)
#if defined(VXWORKS)
init_done = 0;
#endif
+ erts_smp_atomic_init_nob(&warned_for_tuple_funs, (erts_aint_t) 0);
process_main();
}
@@ -1095,7 +1064,7 @@ void process_main(void)
Process* c_p = NULL;
int reds_used;
#ifdef DEBUG
- Eterm pid;
+ ERTS_DECLARE_DUMMY(Eterm pid);
#endif
/*
@@ -1146,26 +1115,11 @@ void process_main(void)
Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */
#endif
-#ifndef ERTS_SMP
-#if !HALFWORD_HEAP
- static Eterm save_reg[ERTS_X_REGS_ALLOCATED];
- /* X registers -- not used directly, but
- * through 'reg', because using it directly
- * needs two instructions on a SPARC,
- * while using it through reg needs only
- * one.
- */
-#endif
/*
- * Floating point registers.
- */
- static FloatDef freg[MAX_REG];
-#else
- /* X regisers and floating point registers are located in
+ * X registers and floating point registers are located in
* scheduler specific data.
*/
register FloatDef *freg;
-#endif
/*
* For keeping the negative old value of 'reds' when call saving is active.
@@ -1202,14 +1156,6 @@ void process_main(void)
init_done = 1;
goto init_emulator;
}
-#ifndef ERTS_SMP
-#if !HALFWORD_HEAP
- reg = save_reg; /* XXX: probably wastes a register on x86 */
-#else
- /* Registers need to be heap allocated (correct memory range) for tracing to work */
- reg = erts_alloc(ERTS_ALC_T_BEAM_REGISTER, ERTS_X_REGS_ALLOCATED * sizeof(Eterm));
-#endif
-#endif
c_p = NULL;
reds_used = 0;
goto do_schedule1;
@@ -1226,14 +1172,12 @@ void process_main(void)
c_p = schedule(c_p, reds_used);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
#ifdef DEBUG
- pid = c_p->id;
+ pid = c_p->id; /* Save for debugging purpouses */
#endif
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
-#ifdef ERTS_SMP
- reg = c_p->scheduler_data->save_reg;
- freg = c_p->scheduler_data->freg;
-#endif
+ reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
+ freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
#if !HEAP_ON_C_STACK
tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap;
#endif
@@ -1567,9 +1511,17 @@ void process_main(void)
PRE_BIF_SWAPOUT(c_p);
c_p->fcalls = FCALLS - 1;
- result = send_2(c_p, r(0), x(1));
+ reg[0] = r(0);
+ result = erl_send(c_p, r(0), x(1));
PreFetch(0, next);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 2);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
+ result = erts_gc_after_bif_call(c_p, result, reg, 2);
+ r(0) = reg[0];
+ E = c_p->stop;
+ }
+ HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
r(0) = result;
@@ -1577,10 +1529,9 @@ void process_main(void)
NextPF(0, next);
} else if (c_p->freason == TRAP) {
SET_CP(c_p, I+1);
- SET_I(*((BeamInstr **) (BeamInstr) ((c_p)->def_arg_reg + 3)));
+ SET_I(c_p->i);
SWAPIN;
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
+ r(0) = reg[0];
Dispatch();
}
goto find_func_info;
@@ -2235,16 +2186,16 @@ void process_main(void)
OpCase(bif1_fbsd):
{
- Eterm (*bf)(Process*, Eterm);
- Eterm arg;
+ Eterm (*bf)(Process*, Eterm*);
+ Eterm tmp_reg[1];
Eterm result;
- GetArg1(2, arg);
+ GetArg1(2, tmp_reg[0]);
bf = (BifFunction) Arg(1);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, arg);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2263,17 +2214,17 @@ void process_main(void)
OpCase(bif1_body_bsd):
{
- Eterm (*bf)(Process*, Eterm);
+ Eterm (*bf)(Process*, Eterm*);
- Eterm arg;
+ Eterm tmp_reg[1];
Eterm result;
- GetArg1(1, arg);
+ GetArg1(1, tmp_reg[0]);
bf = (BifFunction) Arg(0);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, arg);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2282,7 +2233,7 @@ void process_main(void)
if (is_value(result)) {
StoreBifResult(2, result);
}
- reg[0] = arg;
+ reg[0] = tmp_reg[0];
SWAPOUT;
I = handle_error(c_p, I, reg, bf);
goto post_error_handling;
@@ -2406,14 +2357,15 @@ void process_main(void)
*/
OpCase(i_bif2_fbd):
{
- Eterm (*bf)(Process*, Eterm, Eterm);
+ Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm (*bf)(Process*, Eterm*);
Eterm result;
bf = (BifFunction) Arg(1);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_arg1, tmp_arg2);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2431,13 +2383,14 @@ void process_main(void)
*/
OpCase(i_bif2_body_bd):
{
- Eterm (*bf)(Process*, Eterm, Eterm);
+ Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm (*bf)(Process*, Eterm*);
Eterm result;
bf = (BifFunction) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_arg1, tmp_arg2);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2457,77 +2410,9 @@ void process_main(void)
* The most general BIF call. The BIF may build any amount of data
* on the heap. The result is always returned in r(0).
*/
- OpCase(call_bif0_e):
+ OpCase(call_bif_e):
{
- Eterm (*bf)(Process*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
-
- PRE_BIF_SWAPOUT(c_p);
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
- }
-
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- r(0) = (*bf)(c_p, I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(r(0)));
- ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN_0(c_p, r(0));
- FCALLS = c_p->fcalls;
- if (is_value(r(0))) {
- CHECK_TERM(r(0));
- Next(1);
- }
- else if (c_p->freason == TRAP) {
- goto call_bif_trap3;
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
- reg[0] = r(0);
- I = handle_error(c_p, I, reg, bf);
- goto post_error_handling;
- }
-
- OpCase(call_bif1_e):
- {
- Eterm (*bf)(Process*, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
- Eterm result;
- BeamInstr *next;
-
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
- }
- PreFetch(1, next);
- PRE_BIF_SWAPOUT(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, r(0), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 1);
- FCALLS = c_p->fcalls;
- if (is_value(result)) {
- r(0) = result;
- CHECK_TERM(r(0));
- NextPF(1, next);
- } else if (c_p->freason == TRAP) {
- goto call_bif_trap3;
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
- reg[0] = r(0);
- I = handle_error(c_p, I, reg, bf);
- goto post_error_handling;
- }
-
- OpCase(call_bif2_e):
- {
- Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
+ Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
Eterm result;
BeamInstr *next;
@@ -2537,61 +2422,29 @@ void process_main(void)
save_calls(c_p, (Export *) Arg(0));
}
PreFetch(1, next);
- CHECK_TERM(r(0));
- CHECK_TERM(x(1));
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, r(0), x(1), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 2);
- FCALLS = c_p->fcalls;
- if (is_value(result)) {
- r(0) = result;
- CHECK_TERM(r(0));
- NextPF(1, next);
- } else if (c_p->freason == TRAP) {
- goto call_bif_trap3;
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
reg[0] = r(0);
- I = handle_error(c_p, I, reg, bf);
- goto post_error_handling;
- }
-
- OpCase(call_bif3_e):
- {
- Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
- Eterm result;
- BeamInstr *next;
-
- PRE_BIF_SWAPOUT(c_p);
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
- }
- PreFetch(1, next);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, r(0), x(1), x(2), I);
+ result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 3);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
+ Uint arity = ((Export *)Arg(0))->code[2];
+ result = erts_gc_after_bif_call(c_p, result, reg, arity);
+ E = c_p->stop;
+ }
+ HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
r(0) = result;
CHECK_TERM(r(0));
NextPF(1, next);
} else if (c_p->freason == TRAP) {
- call_bif_trap3:
SET_CP(c_p, I+2);
- SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3)));
+ SET_I(c_p->i);
SWAPIN;
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
- x(2) = c_p->def_arg_reg[2];
+ r(0) = reg[0];
Dispatch();
}
@@ -2599,7 +2452,6 @@ void process_main(void)
* Error handling. SWAPOUT is not needed because it was done above.
*/
ASSERT(c_p->stop == E);
- reg[0] = r(0);
I = handle_error(c_p, I, reg, bf);
goto post_error_handling;
}
@@ -2695,6 +2547,7 @@ void process_main(void)
lb_Cl_error: {
if (Arg(0) != 0) {
OpCase(jump_f): {
+ jump_f:
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
@@ -3268,7 +3121,7 @@ void process_main(void)
/* Fall through */
OpCase(error_action_code): {
- no_error_handler:
+ handle_error:
reg[0] = r(0);
SWAPOUT;
I = handle_error(c_p, NULL, reg, NULL);
@@ -3352,64 +3205,23 @@ void process_main(void)
ASSERT(bif_nif_arity <= 3);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- switch (bif_nif_arity) {
- case 3:
- {
- Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- break;
- case 2:
- {
- Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, r(0), x(1), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- break;
- case 1:
- {
- Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, r(0), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- break;
- case 0:
- {
- Eterm (*bf)(Process*, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- break;
- }
- default:
- erl_exit(1, "apply_bif: invalid arity: %u\n",
- bif_nif_arity);
+ reg[0] = r(0);
+ {
+ Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ nif_bif_result = (*bf)(c_p, reg, I);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
}
apply_bif_or_nif_epilogue:
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
ERTS_HOLE_CHECK(c_p);
if (c_p->mbuf) {
- reg[0] = r(0);
nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result,
reg, bif_nif_arity);
- r(0) = reg[0];
}
SWAPIN; /* There might have been a garbage collection. */
FCALLS = c_p->fcalls;
@@ -3420,17 +3232,14 @@ void process_main(void)
c_p->cp = 0;
Goto(*I);
} else if (c_p->freason == TRAP) {
- SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3)));
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
- x(2) = c_p->def_arg_reg[2];
+ SET_I(c_p->i);
+ r(0) = reg[0];
if (c_p->flags & F_HIBERNATE_SCHED) {
c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
}
Dispatch();
}
- reg[0] = r(0);
I = handle_error(c_p, c_p->cp, reg, vbf);
goto post_error_handling;
}
@@ -3473,7 +3282,7 @@ void process_main(void)
OpCase(i_func_info_IaaI): {
c_p->freason = EXC_FUNCTION_CLAUSE;
c_p->current = I + 2;
- goto lb_error_action_code;
+ goto handle_error;
}
OpCase(try_case_end_s):
@@ -3993,8 +3802,7 @@ void process_main(void)
* too big numbers).
*/
if (is_not_small(val) || val > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL)) ||
- val == make_small(0xFFFEUL) || val == make_small(0xFFFFUL)) {
+ (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) {
goto badarg;
}
Next(2);
@@ -4013,8 +3821,8 @@ void process_main(void)
* the valid range).
*/
if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= tmp_arg1 && tmp_arg1 <= make_small(0xDFFFUL)) ||
- tmp_arg1 == make_small(0xFFFEUL) || tmp_arg1 == make_small(0xFFFFUL)) {
+ (make_small(0xD800UL) <= tmp_arg1 &&
+ tmp_arg1 <= make_small(0xDFFFUL))) {
ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2);
mb->offset -= 32;
@@ -4889,92 +4697,6 @@ void process_main(void)
}
/*
- * Instructions for allocating on the message area.
- */
-
- OpCase(i_global_cons):
- {
- BeamInstr *next;
-#ifdef HYBRID
- Eterm *hp;
-
- PreFetch(0,next);
- TestGlobalHeap(2,2,hp);
- hp[0] = r(0);
- hp[1] = x(1);
- r(0) = make_list(hp);
-#ifndef INCREMENTAL
- global_htop += 2;
-#endif
- NextPF(0,next);
-#else
- PreFetch(0,next);
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- OpCase(i_global_tuple):
- {
- BeamInstr *next;
- int len;
-#ifdef HYBRID
- Eterm list;
- Eterm *hp;
-#endif
-
- if ((len = list_length(r(0))) < 0) {
- goto badarg;
- }
-
- PreFetch(0,next);
-#ifdef HYBRID
- TestGlobalHeap(len + 1,1,hp);
- list = r(0);
- r(0) = make_tuple(hp);
- *hp++ = make_arityval(len);
- while(is_list(list))
- {
- Eterm* cons = list_val(list);
- *hp++ = CAR(cons);
- list = CDR(cons);
- }
-#ifndef INCREMENTAL
- global_htop += len + 1;
-#endif
- NextPF(0,next);
-#else
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- OpCase(i_global_copy):
- {
- BeamInstr *next;
- PreFetch(0,next);
-#ifdef HYBRID
- if (!IS_CONST(r(0)))
- {
- BM_SWAP_TIMER(system,copy);
- SWAPOUT;
- reg[0] = r(0);
- reg[1] = NIL;
- r(0) = copy_struct_lazy(c_p,r(0),0);
- ASSERT(ma_src_top == 0);
- ASSERT(ma_dst_top == 0);
- ASSERT(ma_offset_top == 0);
- SWAPIN;
- BM_SWAP_TIMER(copy,system);
- }
- NextPF(0,next);
-#else
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- /*
* New floating point instructions.
*/
@@ -5033,7 +4755,12 @@ void process_main(void)
OpCase(fclearerror):
OpCase(i_fcheckerror):
erl_exit(1, "fclearerror/i_fcheckerror without fpe signals (beam_emu)");
+# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT
+# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR
#else
+# define ERTS_NO_FPE_CHECK_INIT(p)
+# define ERTS_NO_FPE_ERROR(p, a, b)
+
OpCase(fclearerror): {
BeamInstr *next;
@@ -5049,10 +4776,6 @@ void process_main(void)
ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith);
NextPF(0, next);
}
-# undef ERTS_FP_CHECK_INIT
-# undef ERTS_FP_ERROR
-# define ERTS_FP_CHECK_INIT(p)
-# define ERTS_FP_ERROR(p, a, b)
#endif
@@ -5060,45 +4783,45 @@ void process_main(void)
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fsub_lll): {
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fmul_lll): {
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fdiv_lll): {
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fnegate_ll): {
BeamInstr *next;
PreFetch(2, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(1)) = -fb(Arg(0));
- ERTS_FP_ERROR(c_p, fb(Arg(1)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(1)), goto fbadarith);
NextPF(2, next);
fbadarith:
@@ -5152,10 +4875,8 @@ void process_main(void)
c_p->def_arg_reg[4] = -neg_o_reds;
reg[0] = r(0);
c_p = hipe_mode_switch(c_p, cmd, reg);
-#ifdef ERTS_SMP
- reg = c_p->scheduler_data->save_reg;
- freg = c_p->scheduler_data->freg;
-#endif
+ reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
+ freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
ERL_BITS_RELOAD_STATEP(c_p);
neg_o_reds = -c_p->def_arg_reg[4];
FCALLS = c_p->fcalls;
@@ -5247,7 +4968,7 @@ void process_main(void)
if (I) {
Goto(*I);
}
- goto no_error_handler;
+ goto handle_error;
}
@@ -5269,8 +4990,8 @@ void process_main(void)
OpCase(int_code_end):
OpCase(label_L):
- OpCase(too_old_compiler):
OpCase(on_load):
+ OpCase(line_I):
erl_exit(1, "meta op\n");
/*
@@ -5687,6 +5408,25 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) {
* that c_p->ftrace will point to a cons cell which holds the given args
* and the saved data (encoded as a bignum).
*
+ * There is an issue with line number information. Line number
+ * information is associated with the address *before* an operation
+ * that may fail or be stored stored on the stack. But continuation
+ * pointers point after its call instruction, not before. To avoid
+ * finding the wrong line number, we'll need to adjust them so that
+ * they point at the beginning of the call instruction or inside the
+ * call instruction. Since its impractical to point at the beginning,
+ * we'll do the simplest thing and decrement the continuation pointers
+ * by one.
+ *
+ * Here is an example of what can go wrong. Without the adjustment
+ * of continuation pointers, the call at line 42 below would seem to
+ * be at line 43:
+ *
+ * line 42
+ * call ...
+ * line 43
+ * gc_bif ...
+ *
* (It would be much better to put the arglist - when it exists - in the
* error value instead of in the actual trace; e.g. '{badarg, Args}'
* instead of using 'badarg' with Args in the trace. The arglist may
@@ -5753,7 +5493,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
}
/* Save second stack entry if CP is valid and different from pc */
if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) {
- s->trace[s->depth++] = c_p->cp;
+ s->trace[s->depth++] = c_p->cp - 1;
depth--;
}
s->pc = NULL;
@@ -5773,13 +5513,13 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
/* Save first stack entry */
ASSERT(c_p->cp);
if (depth > 0) {
- s->trace[s->depth++] = c_p->cp;
+ s->trace[s->depth++] = c_p->cp - 1;
depth--;
}
s->pc = NULL; /* Ignore pc */
} else {
if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) {
- s->trace[s->depth++] = c_p->cp;
+ s->trace[s->depth++] = c_p->cp - 1;
depth--;
}
s->pc = pc;
@@ -5794,24 +5534,31 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
}
/* Save the actual stack trace */
+ erts_save_stacktrace(c_p, s, depth);
+}
+
+void
+erts_save_stacktrace(Process* p, struct StackTrace* s, int depth)
+{
if (depth > 0) {
Eterm *ptr;
BeamInstr *prev = s->depth ? s->trace[s->depth-1] : NULL;
BeamInstr i_return_trace = beam_return_trace[0];
BeamInstr i_return_to_trace = beam_return_to_trace[0];
+
/*
* Traverse the stack backwards and add all unique continuation
* pointers to the buffer, up to the maximum stack trace size.
*
* Skip trace stack frames.
*/
- ptr = c_p->stop;
- if (ptr < STACK_START(c_p)
- && (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace &&
- *cp_val(*ptr) != i_return_to_trace))
- && c_p->cp) {
- /* Can not follow cp here - code may be unloaded */
- BeamInstr *cpp = c_p->cp;
+ ptr = p->stop;
+ if (ptr < STACK_START(p) &&
+ (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace &&
+ *cp_val(*ptr) != i_return_to_trace)) &&
+ p->cp) {
+ /* Cannot follow cp here - code may be unloaded */
+ BeamInstr *cpp = p->cp;
if (cpp == beam_exception_trace || cpp == beam_return_trace) {
/* Skip return_trace parameters */
ptr += 2;
@@ -5820,7 +5567,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
ptr += 1;
}
}
- while (ptr < STACK_START(c_p) && depth > 0) {
+ while (ptr < STACK_START(p) && depth > 0) {
if (is_CP(*ptr)) {
if (*cp_val(*ptr) == i_return_trace) {
/* Skip stack frame variables */
@@ -5835,7 +5582,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
if (cp != prev) {
/* Record non-duplicates only */
prev = cp;
- s->trace[s->depth++] = cp;
+ s->trace[s->depth++] = cp - 1;
depth--;
}
ptr++;
@@ -5903,9 +5650,14 @@ build_stacktrace(Process* c_p, Eterm exc) {
struct StackTrace* s;
Eterm args;
int depth;
- BeamInstr* current;
- Eterm Where = NIL;
- Eterm *next_p = &Where;
+ FunctionInfo fi;
+ FunctionInfo* stk;
+ FunctionInfo* stkp;
+ Eterm res = NIL;
+ Uint heap_size;
+ Eterm* hp;
+ Eterm mfa;
+ int i;
if (! (s = get_trace_from_exc(exc))) {
return NIL;
@@ -5924,64 +5676,56 @@ build_stacktrace(Process* c_p, Eterm exc) {
* saved s->current should already contain the proper value.
*/
if (s->pc != NULL) {
- current = find_function_from_pc(s->pc);
+ erts_lookup_function_info(&fi, s->pc, 1);
+ } else if (GET_EXC_INDEX(s->freason) ==
+ GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) {
+ erts_lookup_function_info(&fi, s->current, 1);
} else {
- current = s->current;
+ erts_set_current_function(&fi, s->current);
}
+
/*
- * If current is still NULL, default to the initial function
+ * If fi.current is still NULL, default to the initial function
* (e.g. spawn_link(erlang, abs, [1])).
*/
- if (current == NULL) {
- current = c_p->initial;
+ if (fi.current == NULL) {
+ erts_set_current_function(&fi, c_p->initial);
args = am_true; /* Just in case */
} else {
args = get_args_from_exc(exc);
}
- depth = s->depth;
-
/*
- * Add the {M,F,A} for the current function
- * (where A is arity or [Argument]).
+ * Look up all saved continuation pointers and calculate
+ * needed heap space.
*/
- {
- int i;
- Eterm mfa;
- Uint heap_size = 6*(depth+1);
- Eterm* hp = HAlloc(c_p, heap_size);
- Eterm* hp_end = hp + heap_size;
-
- if (args != am_true) {
- /* We have an arglist - use it */
- mfa = TUPLE3(hp, current[0], current[1], args);
- } else {
- Eterm arity = make_small(current[2]);
- mfa = TUPLE3(hp, current[0], current[1], arity);
+ depth = s->depth;
+ stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
+ depth*sizeof(FunctionInfo));
+ heap_size = fi.needed + 2;
+ for (i = 0; i < depth; i++) {
+ erts_lookup_function_info(stkp, s->trace[i], 1);
+ if (stkp->current) {
+ heap_size += stkp->needed + 2;
+ stkp++;
}
- hp += 4;
- ASSERT(*next_p == NIL);
- *next_p = CONS(hp, mfa, NIL);
- next_p = &CDR(list_val(*next_p));
- hp += 2;
+ }
- /*
- * Finally, we go through the saved continuation pointers.
- */
- for (i = 0; i < depth; i++) {
- BeamInstr *fi = find_function_from_pc((BeamInstr *) s->trace[i]);
- if (fi == NULL) continue;
- mfa = TUPLE3(hp, fi[0], fi[1], make_small(fi[2]));
- hp += 4;
- ASSERT(*next_p == NIL);
- *next_p = CONS(hp, mfa, NIL);
- next_p = &CDR(list_val(*next_p));
- hp += 2;
- }
- ASSERT(hp <= hp_end);
- HRelease(c_p, hp_end, hp);
+ /*
+ * Allocate heap space and build the stacktrace.
+ */
+ hp = HAlloc(c_p, heap_size);
+ while (stkp > stk) {
+ stkp--;
+ hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
+ res = CONS(hp, mfa, res);
+ hp += 2;
}
- return Where;
+ hp = erts_build_mfa_item(&fi, hp, args, &mfa);
+ res = CONS(hp, mfa, res);
+
+ erts_free(ERTS_ALC_T_TMP, (void *) stk);
+ return res;
}
@@ -6451,6 +6195,26 @@ call_fun(Process* p, /* Current process. */
if (!is_atom(module) || !is_atom(function)) {
goto badfun;
}
+
+ /*
+ * If this is the first time a tuple fun is used,
+ * send a warning to the logger.
+ */
+ if (erts_smp_atomic_xchg_nob(&warned_for_tuple_funs,
+ (erts_aint_t) 1) == 0) {
+ erts_dsprintf_buf_t* dsbufp;
+
+ dsbufp = erts_create_logger_dsbuf();
+ erts_dsprintf(dsbufp, "Call to tuple fun {%T,%T}.\n\n"
+ "Tuple funs are deprecated and will be removed "
+ "in R16. Use \"fun M:F/A\" instead, for example "
+ "\"fun %T:%T/%d\".\n\n"
+ "(This warning will only be shown the first time "
+ "a tuple fun is called.)\n",
+ module, function, module, function, arity);
+ erts_send_warning_to_logger(p->group_leader, dsbufp);
+ }
+
if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
ep = erts_find_export_entry(erts_proc_get_error_handler(p),
am_undefined_function, 3);
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index fceb352cf3..d8434c098e 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -158,6 +158,7 @@ typedef struct {
#define LITERAL_CHUNK 6
#define ATTR_CHUNK 7
#define COMPILE_CHUNK 8
+#define LINE_CHUNK 9
#define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0]))
@@ -182,6 +183,7 @@ static Uint chunk_types[] = {
MakeIffId('L', 'i', 't', 'T'), /* 6 */
MakeIffId('A', 't', 't', 'r'), /* 7 */
MakeIffId('C', 'I', 'n', 'f'), /* 8 */
+ MakeIffId('L', 'i', 'n', 'e'), /* 9 */
};
/*
@@ -204,6 +206,7 @@ typedef struct {
Eterm term; /* The tagged term (in the heap). */
Uint heap_size; /* (Exact) size on the heap. */
Uint offset; /* Offset from temporary location to final. */
+ ErlOffHeap off_heap; /* Start of linked list of ProcBins. */
Eterm* heap; /* Heap for term. */
} Literal;
@@ -231,10 +234,19 @@ struct string_patch {
};
/*
+ * This structure associates a code offset with a source code location.
+ */
+
+typedef struct {
+ int pos; /* Position in code */
+ Uint32 loc; /* Location in source code */
+} LineInstr;
+
+/*
* This structure contains all information about the module being loaded.
*/
-typedef struct {
+typedef struct LoaderState {
/*
* The current logical file within the binary.
*/
@@ -242,6 +254,7 @@ typedef struct {
char* file_name; /* Name of file we are reading (usually chunk name). */
byte* file_p; /* Current pointer within file. */
unsigned file_left; /* Number of bytes left in file. */
+ ErlDrvBinary* bin; /* Binary holding BEAM file (or NULL) */
/*
* The following are used mainly for diagnostics.
@@ -276,7 +289,6 @@ typedef struct {
BeamInstr* code; /* Loaded code. */
int ci; /* Current index into loaded code. */
Label* labels;
- BeamInstr new_bs_put_strings; /* Linked list of i_new_bs_put_string instructions. */
StringPatch* string_patches; /* Linked list of position into string table to patch. */
BeamInstr catches; /* Linked list of catch_yf instructions. */
unsigned loaded_size; /* Final size of code when loaded. */
@@ -325,12 +337,41 @@ typedef struct {
Literal* literals; /* Array of literals. */
LiteralPatch* literal_patches; /* Operands that need to be patched. */
Uint total_literal_size; /* Total heap size for all literals. */
+
+ /*
+ * Line table.
+ */
+ BeamInstr* line_item; /* Line items from the BEAM file. */
+ int num_line_items; /* Number of line items. */
+ LineInstr* line_instr; /* Line instructions */
+ int num_line_instrs; /* Maximum number of line instructions */
+ int current_li; /* Current line instruction */
+ int* func_line; /* Mapping from function to first line instr */
+ Eterm* fname; /* List of file names */
+ int num_fnames; /* Number of filenames in fname table */
+ int loc_size; /* Size of location info in bytes (2/4) */
} LoaderState;
-typedef struct {
- unsigned num_functions; /* Number of functions. */
- Eterm* func_tab[1]; /* Pointers to each function. */
-} LoadedCode;
+/*
+ * Layout of the line table.
+ */
+
+#define MI_LINE_FNAME_PTR 0
+#define MI_LINE_LOC_TAB 1
+#define MI_LINE_LOC_SIZE 2
+#define MI_LINE_FUNC_TAB 3
+
+#define LINE_INVALID_LOCATION (0)
+
+/*
+ * Macros for manipulating locations.
+ */
+
+#define IS_VALID_LOCATION(File, Line) \
+ ((unsigned) (File) < 255 && (unsigned) (Line) < ((1 << 24) - 1))
+#define MAKE_LOCATION(File, Line) (((File) << 24) | (Line))
+#define LOC_FILE(Loc) ((Loc) >> 24)
+#define LOC_LINE(Loc) ((Loc) & ((1 << 24)-1))
#define GetTagAndValue(Stp, Tag, Val) \
do { \
@@ -455,19 +496,20 @@ typedef struct {
} while (0)
-static int bin_load(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size);
-static void init_state(LoaderState* stp);
-static int insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module,
- BeamInstr* code, Uint size, BeamInstr catches);
+static void free_state(LoaderState* stp);
+static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm group_leader, Eterm module,
+ BeamInstr* code, Uint size);
+static int init_iff_file(LoaderState* stp, byte* code, Uint size);
static int scan_iff_file(LoaderState* stp, Uint* chunk_types,
Uint num_types, Uint num_mandatory);
+static int verify_chunks(LoaderState* stp);
static int load_atom_table(LoaderState* stp);
static int load_import_table(LoaderState* stp);
static int read_export_table(LoaderState* stp);
static int read_lambda_table(LoaderState* stp);
static int read_literal_table(LoaderState* stp);
+static int read_line_table(LoaderState* stp);
static int read_code_header(LoaderState* stp);
static int load_code(LoaderState* stp);
static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
@@ -506,6 +548,8 @@ static Eterm native_addresses(Process* p, Eterm mod);
int patch_funentries(Eterm Patchlist);
int patch(Eterm Addresses, Uint fe);
static int safe_mul(UWord a, UWord b, UWord* resp);
+static void lookup_loc(FunctionInfo* fi, BeamInstr* pc,
+ BeamInstr* modp, int idx);
static int must_swap_floats;
@@ -550,7 +594,7 @@ define_file(LoaderState* stp, char* name, int idx)
stp->file_left = stp->chunks[idx].size;
}
-int
+Eterm
erts_load_module(Process *c_p,
ErtsProcLocks c_p_locks,
Eterm group_leader, /* Group leader or NIL if none. */
@@ -559,29 +603,17 @@ erts_load_module(Process *c_p,
* On return, contains the actual module name.
*/
byte* code, /* Points to the code to load */
- int size) /* Size of code to load. */
+ Uint size) /* Size of code to load. */
{
- ErlDrvBinary* bin;
- int result;
+ LoaderState* stp = erts_alloc_loader_state();
+ Eterm retval;
- if (size >= 4 && code[0] == 'F' && code[1] == 'O' &&
- code[2] == 'R' && code[3] == '1') {
- /*
- * The BEAM module is not compressed.
- */
- result = bin_load(c_p, c_p_locks, group_leader, modp, code, size);
- } else {
- /*
- * The BEAM module is compressed (or possibly invalid/corrupted).
- */
- if ((bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)code, size)) == NULL) {
- return -1;
- }
- result = bin_load(c_p, c_p_locks, group_leader, modp,
- (byte*)bin->orig_bytes, bin->orig_size);
- driver_free_binary(bin);
+ retval = erts_prepare_loading(stp, c_p, group_leader, modp,
+ code, size);
+ if (retval != NIL) {
+ return retval;
}
- return result;
+ return erts_finish_loading(stp, c_p, c_p_locks, modp);
}
/* #define LOAD_MEMORY_HARD_DEBUG 1*/
@@ -596,31 +628,28 @@ extern void check_allocated_block(Uint type, void *blk);
#define CHKBLK(TYPE,BLK) /* nothing */
#endif
-static int
-bin_load(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size)
+Eterm
+erts_prepare_loading(LoaderState* stp, Process *c_p, Eterm group_leader,
+ Eterm* modp, byte* code, Uint unloaded_size)
{
- LoaderState state;
- int rval = -1;
-
- init_state(&state);
- state.module = *modp;
- state.group_leader = group_leader;
+ Eterm retval = am_badfile;
- /*
- * Scan the IFF file.
- */
+ stp->module = *modp;
+ stp->group_leader = group_leader;
#if defined(LOAD_MEMORY_HARD_DEBUG) && defined(DEBUG)
erts_fprintf(stderr,"Loading a module\n");
#endif
+ /*
+ * Scan the IFF file.
+ */
+
CHKALLOC();
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- state.file_name = "IFF header for Beam file";
- state.file_p = bytes;
- state.file_left = unloaded_size;
- if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (!init_iff_file(stp, code, unloaded_size) ||
+ !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !verify_chunks(stp)) {
goto load_error;
}
@@ -628,38 +657,38 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the header for the code chunk.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "code chunk header", CODE_CHUNK);
- if (!read_code_header(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "code chunk header", CODE_CHUNK);
+ if (!read_code_header(stp)) {
goto load_error;
}
/*
* Initialize code area.
*/
- state.code_buffer_size = erts_next_heap_size(2048 + state.num_functions, 0);
- state.code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
- sizeof(BeamInstr) * state.code_buffer_size);
+ stp->code_buffer_size = erts_next_heap_size(2048 + stp->num_functions, 0);
+ stp->code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
+ sizeof(BeamInstr) * stp->code_buffer_size);
- state.code[MI_NUM_FUNCTIONS] = state.num_functions;
- state.ci = MI_FUNCTIONS + state.num_functions + 1;
+ stp->code[MI_NUM_FUNCTIONS] = stp->num_functions;
+ stp->ci = MI_FUNCTIONS + stp->num_functions + 1;
- state.code[MI_ATTR_PTR] = 0;
- state.code[MI_ATTR_SIZE] = 0;
- state.code[MI_ATTR_SIZE_ON_HEAP] = 0;
- state.code[MI_COMPILE_PTR] = 0;
- state.code[MI_COMPILE_SIZE] = 0;
- state.code[MI_COMPILE_SIZE_ON_HEAP] = 0;
- state.code[MI_NUM_BREAKPOINTS] = 0;
+ stp->code[MI_ATTR_PTR] = 0;
+ stp->code[MI_ATTR_SIZE] = 0;
+ stp->code[MI_ATTR_SIZE_ON_HEAP] = 0;
+ stp->code[MI_COMPILE_PTR] = 0;
+ stp->code[MI_COMPILE_SIZE] = 0;
+ stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0;
+ stp->code[MI_NUM_BREAKPOINTS] = 0;
/*
* Read the atom table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "atom table", ATOM_CHUNK);
- if (!load_atom_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "atom table", ATOM_CHUNK);
+ if (!load_atom_table(stp)) {
goto load_error;
}
@@ -667,9 +696,9 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the import table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "import table", IMP_CHUNK);
- if (!load_import_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "import table", IMP_CHUNK);
+ if (!load_import_table(stp)) {
goto load_error;
}
@@ -677,10 +706,10 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the lambda (fun) table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- if (state.chunks[LAMBDA_CHUNK].size > 0) {
- define_file(&state, "lambda (fun) table", LAMBDA_CHUNK);
- if (!read_lambda_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (stp->chunks[LAMBDA_CHUNK].size > 0) {
+ define_file(stp, "lambda (fun) table", LAMBDA_CHUNK);
+ if (!read_lambda_table(stp)) {
goto load_error;
}
}
@@ -689,10 +718,22 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the literal table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- if (state.chunks[LITERAL_CHUNK].size > 0) {
- define_file(&state, "literals table (constant pool)", LITERAL_CHUNK);
- if (!read_literal_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (stp->chunks[LITERAL_CHUNK].size > 0) {
+ define_file(stp, "literals table (constant pool)", LITERAL_CHUNK);
+ if (!read_literal_table(stp)) {
+ goto load_error;
+ }
+ }
+
+ /*
+ * Read the line table (if present).
+ */
+
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (stp->chunks[LINE_CHUNK].size > 0) {
+ define_file(stp, "line table", LINE_CHUNK);
+ if (!read_line_table(stp)) {
goto load_error;
}
}
@@ -701,15 +742,15 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Load the code chunk.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- state.file_name = "code chunk";
- state.file_p = state.code_start;
- state.file_left = state.code_size;
- if (!load_code(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ stp->file_name = "code chunk";
+ stp->file_p = stp->code_start;
+ stp->file_left = stp->code_size;
+ if (!load_code(stp)) {
goto load_error;
}
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- if (!freeze_code(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (!freeze_code(stp)) {
goto load_error;
}
@@ -719,9 +760,49 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* loading the code, because it contains labels.)
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "export table", EXP_CHUNK);
- if (!read_export_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "export table", EXP_CHUNK);
+ if (!read_export_table(stp)) {
+ goto load_error;
+ }
+
+ /*
+ * Good so far.
+ */
+
+ retval = NIL;
+
+ load_error:
+ if (retval != NIL) {
+ free_state(stp);
+ }
+ return retval;
+}
+
+Eterm
+erts_finish_loading(LoaderState* stp, Process* c_p,
+ ErtsProcLocks c_p_locks, Eterm* modp)
+{
+ Eterm retval;
+
+ /*
+ * No other process may run since we will update the export
+ * table which is not protected by any locks.
+ */
+
+ ERTS_SMP_LC_ASSERT(erts_initialized == 0 ||
+ erts_smp_thr_progress_is_blocking());
+
+ /*
+ * Make current code for the module old and insert the new code
+ * as current. This will fail if there already exists old code
+ * for the module.
+ */
+
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module,
+ stp->code, stp->loaded_size);
+ if (retval != NIL) {
goto load_error;
}
@@ -730,88 +811,43 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* exported and imported functions. This can't fail.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- rval = insert_new_code(c_p, c_p_locks, state.group_leader, state.module,
- state.code, state.loaded_size, state.catches);
- if (rval < 0) {
- goto load_error;
- }
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- final_touch(&state);
+ erts_export_consolidate();
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ final_touch(stp);
/*
* Loading succeded.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
#if defined(LOAD_MEMORY_HARD_DEBUG) && defined(DEBUG)
erts_fprintf(stderr,"Loaded %T\n",*modp);
#if 0
- debug_dump_code(state.code,state.ci);
+ debug_dump_code(stp->code,stp->ci);
#endif
#endif
- rval = 0;
- state.code = NULL; /* Prevent code from being freed. */
- *modp = state.module;
+ stp->code = NULL; /* Prevent code from being freed. */
+ *modp = stp->module;
/*
* If there is an on_load function, signal an error to
* indicate that the on_load function must be run.
*/
- if (state.on_load) {
- rval = -5;
+ if (stp->on_load) {
+ retval = am_on_load;
}
load_error:
- if (state.code != 0) {
- erts_free(ERTS_ALC_T_CODE, state.code);
- }
- if (state.labels != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels);
- }
- if (state.atom != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom);
- }
- if (state.import != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.import);
- }
- if (state.export != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export);
- }
- if (state.lambdas != state.def_lambdas) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas);
- }
- if (state.literals != NULL) {
- int i;
- for (i = 0; i < state.num_literals; i++) {
- if (state.literals[i].heap != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals[i].heap);
- }
- }
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals);
- }
- while (state.literal_patches != NULL) {
- LiteralPatch* next = state.literal_patches->next;
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literal_patches);
- state.literal_patches = next;
- }
- while (state.string_patches != NULL) {
- StringPatch* next = state.string_patches->next;
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.string_patches);
- state.string_patches = next;
- }
- while (state.genop_blocks) {
- GenOpBlock* next = state.genop_blocks->next;
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.genop_blocks);
- state.genop_blocks = next;
- }
-
- return rval;
+ free_state(stp);
+ return retval;
}
-
-static void
-init_state(LoaderState* stp)
+LoaderState*
+erts_alloc_loader_state(void)
{
+ LoaderState* stp;
+
+ stp = erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(LoaderState));
+ stp->bin = NULL;
stp->function = THE_NON_VALUE; /* Function not known yet */
stp->arity = 0;
stp->specific_op = -1;
@@ -835,23 +871,98 @@ init_state(LoaderState* stp)
stp->string_patches = 0;
stp->may_load_nif = 0;
stp->on_load = 0;
+ stp->line_item = 0;
+ stp->line_instr = 0;
+ stp->func_line = 0;
+ stp->fname = 0;
+ return stp;
}
-static int
+static void
+free_state(LoaderState* stp)
+{
+ if (stp->bin != 0) {
+ driver_free_binary(stp->bin);
+ }
+ if (stp->code != 0) {
+ erts_free(ERTS_ALC_T_CODE, stp->code);
+ }
+ if (stp->labels != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->labels);
+ }
+ if (stp->atom != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->atom);
+ }
+ if (stp->import != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->import);
+ }
+ if (stp->export != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->export);
+ }
+ if (stp->lambdas != stp->def_lambdas) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->lambdas);
+ }
+ if (stp->literals != NULL) {
+ int i;
+ for (i = 0; i < stp->num_literals; i++) {
+ if (stp->literals[i].heap != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP,
+ (void *) stp->literals[i].heap);
+ }
+ }
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->literals);
+ }
+ while (stp->literal_patches != NULL) {
+ LiteralPatch* next = stp->literal_patches->next;
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->literal_patches);
+ stp->literal_patches = next;
+ }
+ while (stp->string_patches != NULL) {
+ StringPatch* next = stp->string_patches->next;
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->string_patches);
+ stp->string_patches = next;
+ }
+ while (stp->genop_blocks) {
+ GenOpBlock* next = stp->genop_blocks->next;
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->genop_blocks);
+ stp->genop_blocks = next;
+ }
+
+ if (stp->line_item != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->line_item);
+ }
+
+ if (stp->line_instr != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->line_instr);
+ }
+
+ if (stp->func_line != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->func_line);
+ }
+
+ if (stp->fname != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->fname);
+ }
+
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp);
+}
+
+static Eterm
insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module, BeamInstr* code, Uint size, BeamInstr catches)
+ Eterm group_leader, Eterm module, BeamInstr* code,
+ Uint size)
{
Module* modp;
- int rval;
+ Eterm retval;
int i;
- if ((rval = beam_make_current_old(c_p, c_p_locks, module)) < 0) {
+ if ((retval = beam_make_current_old(c_p, c_p_locks, module)) < 0) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp,
"Module %T must be purged before loading\n",
module);
erts_send_error_to_logger(group_leader, dsbufp);
- return rval;
+ return retval;
}
/*
@@ -862,7 +973,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
modp = erts_put_module(module);
modp->code = code;
modp->code_length = size;
- modp->catches = catches;
+ modp->catches = BEAM_CATCHES_NIL; /* Will be filled in later. */
/*
* Update address table (used for finding a function from a PC value).
@@ -884,27 +995,51 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
modules[i].end = (BeamInstr *) (((byte *)code) + size);
num_loaded_modules++;
mid_module = &modules[num_loaded_modules/2];
- return 0;
+ return NIL;
}
static int
-scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory)
+init_iff_file(LoaderState* stp, byte* code, Uint size)
{
- MD5_CTX context;
+ Uint form_id = MakeIffId('F', 'O', 'R', '1');
Uint id;
Uint count;
- int i;
+
+ if (size < 4) {
+ goto load_error;
+ }
/*
- * The binary must start with an IFF 'FOR1' chunk.
+ * Check if the module is compressed (or possibly invalid/corrupted).
*/
+ if (MakeIffId(code[0], code[1], code[2], code[3]) != form_id) {
+ stp->bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)code, size);
+ if (stp->bin == NULL) {
+ goto load_error;
+ }
+ code = (byte*)stp->bin->orig_bytes;
+ size = stp->bin->orig_size;
+ if (size < 4) {
+ goto load_error;
+ }
+ }
- GetInt(stp, 4, id);
- if (id != MakeIffId('F', 'O', 'R', '1')) {
+ /*
+ * The binary must start with an IFF 'FOR1' chunk.
+ */
+ if (MakeIffId(code[0], code[1], code[2], code[3]) != form_id) {
LoadError0(stp, "not a BEAM file: no IFF 'FOR1' chunk");
}
/*
+ * Initialize our "virtual file system".
+ */
+
+ stp->file_name = "IFF header for Beam file";
+ stp->file_p = code + 4;
+ stp->file_left = size - 4;
+
+ /*
* Retrieve the chunk size and verify it. If the size is equal to
* or less than the size of the binary, it is ok and we will use it
* as the limit for the logical file size.
@@ -925,6 +1060,21 @@ scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mand
if (id != MakeIffId('B', 'E', 'A', 'M')) {
LoadError0(stp, "not a BEAM file: IFF form type is not 'BEAM'");
}
+ return 1;
+
+ load_error:
+ return 0;
+}
+
+/*
+ * Scan the IFF file. The header should have been verified by init_iff_file().
+ */
+static int
+scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory)
+{
+ Uint count;
+ Uint id;
+ int i;
/*
* Initialize the chunks[] array in the state.
@@ -981,17 +1131,25 @@ scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mand
stp->file_p += count;
stp->file_left -= count;
}
+ return 1;
- /*
- * At this point, we have read the entire IFF file, and we
- * know that it is syntactically correct.
- *
- * Now check that it contains all mandatory chunks. At the
- * same time calculate the MD5 for the module.
- */
+ load_error:
+ return 0;
+}
+
+/*
+ * Verify that all mandatory chunks are present and calculate
+ * MD5 for the module.
+ */
+
+static int
+verify_chunks(LoaderState* stp)
+{
+ int i;
+ MD5_CTX context;
MD5Init(&context);
- for (i = 0; i < num_mandatory; i++) {
+ for (i = 0; i < NUM_MANDATORY; i++) {
if (stp->chunks[i].start != NULL) {
MD5Update(&context, stp->chunks[i].start, stp->chunks[i].size);
} else {
@@ -1001,41 +1159,49 @@ scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mand
LoadError1(stp, "mandatory chunk of type '%s' not found\n", sbuf);
}
}
- if (LITERAL_CHUNK < num_types) {
- if (stp->chunks[LAMBDA_CHUNK].start != 0) {
- byte* start = stp->chunks[LAMBDA_CHUNK].start;
- Uint left = stp->chunks[LAMBDA_CHUNK].size;
- /*
- * The idea here is to ignore the OldUniq field for the fun; it is
- * based on the old broken hash function, which can be different
- * on little endian and big endian machines.
- */
- if (left >= 4) {
- static byte zero[4];
- MD5Update(&context, start, 4);
- start += 4;
- left -= 4;
+ /*
+ * If there is a lambda chunk, include parts of it in the MD5.
+ */
+ if (stp->chunks[LAMBDA_CHUNK].start != 0) {
+ byte* start = stp->chunks[LAMBDA_CHUNK].start;
+ Uint left = stp->chunks[LAMBDA_CHUNK].size;
+
+ /*
+ * The idea here is to ignore the OldUniq field for the fun; it is
+ * based on the old broken hash function, which can be different
+ * on little endian and big endian machines.
+ */
+ if (left >= 4) {
+ static byte zero[4];
+ MD5Update(&context, start, 4);
+ start += 4;
+ left -= 4;
- while (left >= 24) {
- /* Include: Function Arity Index NumFree */
- MD5Update(&context, start, 20);
- /* Set to zero: OldUniq */
- MD5Update(&context, zero, 4);
- start += 24;
- left -= 24;
- }
- }
- /* Can't happen for a correct 'FunT' chunk */
- if (left > 0) {
- MD5Update(&context, start, left);
+ while (left >= 24) {
+ /* Include: Function Arity Index NumFree */
+ MD5Update(&context, start, 20);
+ /* Set to zero: OldUniq */
+ MD5Update(&context, zero, 4);
+ start += 24;
+ left -= 24;
}
}
- if (stp->chunks[LITERAL_CHUNK].start != 0) {
- MD5Update(&context, stp->chunks[LITERAL_CHUNK].start,
- stp->chunks[LITERAL_CHUNK].size);
+ /* Can't happen for a correct 'FunT' chunk */
+ if (left > 0) {
+ MD5Update(&context, start, left);
}
}
+
+
+ /*
+ * If there is a literal chunk, include it in the MD5.
+ */
+ if (stp->chunks[LITERAL_CHUNK].start != 0) {
+ MD5Update(&context, stp->chunks[LITERAL_CHUNK].start,
+ stp->chunks[LITERAL_CHUNK].size);
+ }
+
MD5Final(stp->mod_md5, &context);
return 1;
@@ -1297,12 +1463,14 @@ read_literal_table(LoaderState* stp)
GetInt(stp, 4, sz); /* Size of external term format. */
GetString(stp, p, sz);
- if ((heap_size = erts_decode_ext_size(p, sz, 1)) < 0) {
+ if ((heap_size = erts_decode_ext_size(p, sz)) < 0) {
LoadError1(stp, "literal %d: bad external format", i);
}
hp = stp->literals[i].heap = erts_alloc(ERTS_ALC_T_LOADER_TMP,
heap_size*sizeof(Eterm));
- val = erts_decode_ext(&hp, NULL, &p);
+ stp->literals[i].off_heap.first = 0;
+ stp->literals[i].off_heap.overhead = 0;
+ val = erts_decode_ext(&hp, &stp->literals[i].off_heap, &p);
stp->literals[i].heap_size = hp - stp->literals[i].heap;
if (stp->literals[i].heap_size > heap_size) {
erl_exit(1, "overrun by %d word(s) for literal heap, term %d",
@@ -1324,6 +1492,138 @@ read_literal_table(LoaderState* stp)
return 0;
}
+static int
+read_line_table(LoaderState* stp)
+{
+ unsigned version;
+ ERTS_DECLARE_DUMMY(unsigned flags);
+ int num_line_items;
+ BeamInstr* lp;
+ int i;
+ BeamInstr fname_index;
+ BeamInstr tag;
+
+ /*
+ * If the emulator flag ignoring the line information was given,
+ * return immediately.
+ */
+
+ if (erts_no_line_info) {
+ return 1;
+ }
+
+ /*
+ * Check version of line table.
+ */
+
+ GetInt(stp, 4, version);
+ if (version != 0) {
+ /*
+ * Wrong version. Silently ignore the line number chunk.
+ */
+ return 1;
+ }
+
+ /*
+ * Read the remaining header words. The flag word is reserved
+ * for possible future use; for the moment we ignore it.
+ */
+ GetInt(stp, 4, flags);
+ GetInt(stp, 4, stp->num_line_instrs);
+ GetInt(stp, 4, num_line_items);
+ GetInt(stp, 4, stp->num_fnames);
+
+ /*
+ * Calculate space and allocate memory for the line item table.
+ */
+
+ num_line_items++;
+ lp = (BeamInstr *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ num_line_items * sizeof(BeamInstr));
+ stp->line_item = lp;
+ stp->num_line_items = num_line_items;
+
+ /*
+ * The zeroth entry in the line item table is special.
+ * It contains the undefined location.
+ */
+
+ *lp++ = LINE_INVALID_LOCATION;
+ num_line_items--;
+
+ /*
+ * Read all the line items.
+ */
+
+ stp->loc_size = stp->num_fnames ? 4 : 2;
+ fname_index = 0;
+ while (num_line_items-- > 0) {
+ BeamInstr val;
+ BeamInstr loc;
+
+ GetTagAndValue(stp, tag, val);
+ if (tag == TAG_i) {
+ if (IS_VALID_LOCATION(fname_index, val)) {
+ loc = MAKE_LOCATION(fname_index, val);
+ } else {
+ /*
+ * Too many files or huge line number. Silently invalidate
+ * the location.
+ */
+ loc = LINE_INVALID_LOCATION;
+ }
+ *lp++ = loc;
+ if (val > 0xFFFF) {
+ stp->loc_size = 4;
+ }
+ } else if (tag == TAG_a) {
+ if (val > stp->num_fnames) {
+ LoadError2(stp, "file index overflow (%d/%d)",
+ val, stp->num_fnames);
+ }
+ fname_index = val;
+ num_line_items++;
+ } else {
+ LoadError1(stp, "bad tag '%c' (expected 'a' or 'i')",
+ tag_to_letter[tag]);
+ }
+ }
+
+ /*
+ * Read all filenames.
+ */
+
+ if (stp->num_fnames != 0) {
+ stp->fname = (Eterm *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ stp->num_fnames *
+ sizeof(Eterm));
+ for (i = 0; i < stp->num_fnames; i++) {
+ byte* fname;
+ Uint n;
+
+ GetInt(stp, 2, n);
+ GetString(stp, fname, n);
+ stp->fname[i] = am_atom_put((char*)fname, n);
+ }
+ }
+
+ /*
+ * Allocate the arrays to be filled while code is being loaded.
+ */
+ stp->line_instr = (LineInstr *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ stp->num_line_instrs *
+ sizeof(LineInstr));
+ stp->current_li = 0;
+ stp->func_line = (int *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ stp->num_functions *
+ sizeof(int));
+
+ return 1;
+
+ load_error:
+ return 0;
+}
+
static int
read_code_header(LoaderState* stp)
@@ -1358,10 +1658,15 @@ read_code_header(LoaderState* stp)
/*
* Verify the number of the highest opcode used.
*/
-
GetInt(stp, 4, opcode_max);
if (opcode_max > MAX_GENERIC_OPCODE) {
- LoadError2(stp, "use of opcode %d; this emulator supports only up to %d",
+ LoadError2(stp,
+ "This BEAM file was compiled for a later version"
+ " of the run-time system than " ERLANG_OTP_RELEASE ".\n"
+ " To fix this, please recompile this module with an "
+ ERLANG_OTP_RELEASE " compiler.\n"
+ " (Use of opcode %d; this emulator supports "
+ "only up to %d.)",
opcode_max, MAX_GENERIC_OPCODE);
}
@@ -1382,7 +1687,6 @@ read_code_header(LoaderState* stp)
#endif
}
- stp->new_bs_put_strings = 0;
stp->catches = 0;
return 1;
@@ -1415,7 +1719,7 @@ load_code(LoaderState* stp)
{
int i;
int ci;
- int last_func_start = 0;
+ int last_func_start = 0; /* Needed by nif loading and line instructions */
char* sign;
int arg; /* Number of current argument. */
int num_specific; /* Number of specific ops for current. */
@@ -1428,6 +1732,14 @@ load_code(LoaderState* stp)
GenOp** last_op_next = NULL;
int arity;
+ /*
+ * The size of the loaded func_info instruction is needed
+ * by both the nif functionality and line instructions.
+ */
+ enum {
+ FUNC_INFO_SZ = 5
+ };
+
code = stp->code;
code_buffer_size = stp->code_buffer_size;
ci = stp->ci;
@@ -1667,14 +1979,6 @@ load_code(LoaderState* stp)
}
/*
- * Special error message instruction.
- */
- if (stp->genop->op == genop_too_old_compiler_0) {
- LoadError0(stp, "please re-compile this module with an "
- ERLANG_OTP_RELEASE " compiler");
- }
-
- /*
* From the collected generic instruction, find the specific
* instruction.
*/
@@ -1725,7 +2029,27 @@ load_code(LoaderState* stp)
ERLANG_OTP_RELEASE " compiler ");
}
- LoadError0(stp, "no specific operation found");
+ /*
+ * Some generic instructions should have a special
+ * error message.
+ */
+ switch (stp->genop->op) {
+ case genop_too_old_compiler_0:
+ LoadError0(stp, "please re-compile this module with an "
+ ERLANG_OTP_RELEASE " compiler");
+ case genop_unsupported_guard_bif_3:
+ {
+ Eterm Mod = (Eterm) stp->genop->a[0].val;
+ Eterm Name = (Eterm) stp->genop->a[1].val;
+ Uint arity = (Uint) stp->genop->a[2].val;
+ FREE_GENOP(stp, stp->genop);
+ stp->genop = 0;
+ LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n",
+ Mod, Name, arity);
+ }
+ default:
+ LoadError0(stp, "no specific operation found");
+ }
}
stp->specific_op = specific;
@@ -2014,7 +2338,6 @@ load_code(LoaderState* stp)
case op_i_func_info_IaaI:
{
Uint offset;
- enum { FINFO_SZ = 5 };
if (function_number >= stp->num_functions) {
LoadError1(stp, "too many functions in module (header said %d)",
@@ -2022,27 +2345,37 @@ load_code(LoaderState* stp)
}
if (stp->may_load_nif) {
- const int finfo_ix = ci - FINFO_SZ;
+ const int finfo_ix = ci - FUNC_INFO_SZ;
enum { MIN_FUNC_SZ = 3 };
if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) {
/* Must make room for call_nif op */
int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start);
ASSERT(pad > 0 && pad < MIN_FUNC_SZ);
CodeNeed(pad);
- sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], FINFO_SZ*sizeof(BeamInstr));
+ sys_memmove(&code[finfo_ix+pad], &code[finfo_ix],
+ FUNC_INFO_SZ*sizeof(BeamInstr));
sys_memset(&code[finfo_ix], 0, pad*sizeof(BeamInstr));
ci += pad;
stp->labels[last_label].value += pad;
}
}
last_func_start = ci;
+
+ /*
+ * Save current offset of into the line instruction array.
+ */
+
+ if (stp->func_line) {
+ stp->func_line[function_number] = stp->current_li;
+ }
+
/*
* Save context for error messages.
*/
stp->function = code[ci-2];
stp->arity = code[ci-1];
- ASSERT(stp->labels[last_label].value == ci - FINFO_SZ);
+ ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ);
offset = MI_FUNCTIONS + function_number;
code[offset] = stp->labels[last_label].patches;
stp->labels[last_label].patches = offset;
@@ -2065,32 +2398,6 @@ load_code(LoaderState* stp)
stp->on_load = ci;
break;
case op_bs_put_string_II:
- {
- /*
- * At entry:
- *
- * code[ci-3] &&lb_i_new_bs_put_string_II
- * code[ci-2] length of string
- * code[ci-1] offset into string table
- *
- * Since we don't know the address of the string table yet,
- * just check the offset and length for validity, and use
- * the instruction field as a link field to link all put_string
- * instructions into a single linked list. At exit:
- *
- * code[ci-3] pointer to next i_new_bs_put_string instruction (or 0
- * if this is the last)
- */
- Uint offset = code[ci-1];
- Uint len = code[ci-2];
- unsigned strtab_size = stp->chunks[STR_CHUNK].size;
- if (offset > strtab_size || offset + len > strtab_size) {
- LoadError2(stp, "invalid string reference %d, size %d", offset, len);
- }
- code[ci-3] = stp->new_bs_put_strings;
- stp->new_bs_put_strings = ci - 3;
- }
- break;
case op_i_bs_match_string_rfII:
case op_i_bs_match_string_xfII:
new_string_patch(stp, ci-1);
@@ -2105,6 +2412,45 @@ load_code(LoaderState* stp)
stp->catches = ci-3;
break;
+ case op_line_I:
+ if (stp->line_item) {
+ BeamInstr item = code[ci-1];
+ BeamInstr loc;
+ int li;
+ if (item >= stp->num_line_items) {
+ LoadError2(stp, "line instruction index overflow (%d/%d)",
+ item, stp->num_line_items);
+ }
+ li = stp->current_li;
+ if (li >= stp->num_line_instrs) {
+ LoadError2(stp, "line instruction table overflow (%d/%d)",
+ li, stp->num_line_instrs);
+ }
+ loc = stp->line_item[item];
+
+ if (ci - 2 == last_func_start) {
+ /*
+ * This line instruction directly follows the func_info
+ * instruction. Its address must be adjusted to point to
+ * func_info instruction.
+ */
+ stp->line_instr[li].pos = last_func_start - FUNC_INFO_SZ;
+ stp->line_instr[li].loc = stp->line_item[item];
+ stp->current_li++;
+ } else if (li <= stp->func_line[function_number-1] ||
+ stp->line_instr[li-1].loc != loc) {
+ /*
+ * Only store the location if it is different
+ * from the previous location in the same function.
+ */
+ stp->line_instr[li].pos = ci - 2;
+ stp->line_instr[li].loc = stp->line_item[item];
+ stp->current_li++;
+ }
+ }
+ ci -= 2; /* Get rid of the instruction */
+ break;
+
/*
* End of code found.
*/
@@ -2141,6 +2487,8 @@ load_code(LoaderState* stp)
#define no_fpe_signals(St) 0
#endif
+#define never(St) 0
+
/*
* Predicate that tests whether a jump table can be used.
*/
@@ -3396,10 +3744,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_i_gc_bif1_5;
- op->arity = 5;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
@@ -3420,19 +3765,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
} else if (bf == trunc_1) {
op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_i_gc_bif1_5;
+ op->arity = 5;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = Src;
op->a[3] = Live;
op->a[4] = Dst;
- op->next = NULL;
return op;
}
/*
- * This is used by the ops.tab rule that rewrites gc_bifs with two parameters
+ * This is used by the ops.tab rule that rewrites gc_bifs with two parameters.
* The instruction returned is then again rewritten to an i_load instruction
- * folowed by i_gc_bif2_jIId, to handle literals properly.
+ * followed by i_gc_bif2_jIId, to handle literals properly.
* As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is
* always rewritten, regardless of if there actually are any literals.
*/
@@ -3444,31 +3800,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_ii_gc_bif2_6;
- op->arity = 6;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == binary_part_2) {
op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_ii_gc_bif2_6;
+ op->arity = 6;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = S1;
op->a[3] = S2;
op->a[4] = Live;
op->a[5] = Dst;
- op->next = NULL;
return op;
}
/*
- * This is used by the ops.tab rule that rewrites gc_bifs with three parameters
+ * This is used by the ops.tab rule that rewrites gc_bifs with three parameters.
* The instruction returned is then again rewritten to a move instruction that
* uses r[0] for temp storage, followed by an i_load instruction,
- * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
+ * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
* always occur, as with the gc_bif2 counterpart.
*/
static GenOp*
@@ -3479,18 +3843,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_ii_gc_bif3_7;
- op->arity = 7;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == binary_part_3) {
op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_ii_gc_bif3_7;
+ op->arity = 7;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = S1;
op->a[3] = S2;
op->a[4] = S3;
@@ -3561,15 +3934,14 @@ freeze_code(LoaderState* stp)
{
BeamInstr* code = stp->code;
Uint *literal_end = NULL;
- Uint index;
int i;
byte* str_table;
unsigned strtab_size = stp->chunks[STR_CHUNK].size;
unsigned attr_size = stp->chunks[ATTR_CHUNK].size;
unsigned compile_size = stp->chunks[COMPILE_CHUNK].size;
Uint size;
- unsigned catches;
Sint decoded_size;
+ Uint line_size;
/*
* Verify that there was a correct 'FunT' chunk if there were
@@ -3580,13 +3952,19 @@ freeze_code(LoaderState* stp)
LoadError0(stp, stp->lambda_error);
}
-
/*
* Calculate the final size of the code.
*/
-
- size = (stp->ci * sizeof(BeamInstr)) + (stp->total_literal_size * sizeof(Eterm)) +
- strtab_size + attr_size + compile_size;
+ if (stp->line_instr == 0) {
+ line_size = 0;
+ } else {
+ line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) +
+ (stp->current_li+1) + stp->num_fnames) *
+ sizeof(Eterm) + (stp->current_li+1) * stp->loc_size;
+ }
+ size = (stp->ci * sizeof(BeamInstr)) +
+ (stp->total_literal_size * sizeof(Eterm)) +
+ strtab_size + attr_size + compile_size + line_size;
/*
* Move the code to its final location.
@@ -3623,6 +4001,8 @@ freeze_code(LoaderState* stp)
Uint* low;
Uint* high;
LiteralPatch* lp;
+ struct erl_off_heap_header* off_heap = 0;
+ struct erl_off_heap_header** off_heap_last = &off_heap;
low = (Uint *) (code+stp->ci);
high = low + stp->total_literal_size;
@@ -3631,6 +4011,7 @@ freeze_code(LoaderState* stp)
ptr = low;
for (i = 0; i < stp->num_literals; i++) {
Uint offset;
+ struct erl_off_heap_header* t_off_heap;
sys_memcpy(ptr, stp->literals[i].heap,
stp->literals[i].heap_size*sizeof(Eterm));
@@ -3645,9 +4026,19 @@ freeze_code(LoaderState* stp)
*ptr++ = offset_ptr(val, offset);
break;
case TAG_PRIMARY_HEADER:
- ptr++;
- if (header_is_thing(val)) {
- ptr += thing_arityval(val);
+ if (header_is_transparent(val)) {
+ ptr++;
+ } else {
+ if (thing_subtag(val) == REFC_BINARY_SUBTAG) {
+ struct erl_off_heap_header* oh;
+
+ oh = (struct erl_off_heap_header*) ptr;
+ if (oh->next) {
+ Eterm** uptr = (Eterm **) (void *) &oh->next;
+ *uptr += offset;
+ }
+ }
+ ptr += 1 + thing_arityval(val);
}
break;
default:
@@ -3656,7 +4047,23 @@ freeze_code(LoaderState* stp)
}
}
ASSERT(ptr == high);
+
+ /*
+ * Re-link the off_heap list for this term onto the
+ * off_heap list for the entire module.
+ */
+ t_off_heap = stp->literals[i].off_heap.first;
+ if (t_off_heap) {
+ t_off_heap = (struct erl_off_heap_header *)
+ offset_ptr((UWord) t_off_heap, offset);
+ while (t_off_heap) {
+ *off_heap_last = t_off_heap;
+ off_heap_last = &t_off_heap->next;
+ t_off_heap = t_off_heap->next;
+ }
+ }
}
+ code[MI_LITERALS_OFF_HEAP] = (BeamInstr) off_heap;
lp = stp->literal_patches;
while (lp != 0) {
BeamInstr* op_ptr;
@@ -3674,21 +4081,72 @@ freeze_code(LoaderState* stp)
}
literal_end += stp->total_literal_size;
}
-
+ CHKBLK(ERTS_ALC_T_CODE,code);
+
/*
- * Place the string table and, optionally, attributes, after the literal heap.
+ * If there is line information, place it here.
*/
- CHKBLK(ERTS_ALC_T_CODE,code);
+ if (stp->line_instr == 0) {
+ code[MI_LINE_TABLE] = (BeamInstr) 0;
+ str_table = (byte *) literal_end;
+ } else {
+ Eterm* line_tab = (Eterm *) literal_end;
+ Eterm* p;
+ int ftab_size = stp->num_functions;
+ int num_instrs = stp->current_li;
+ Eterm* first_line_item;
+
+ code[MI_LINE_TABLE] = (BeamInstr) line_tab;
+ p = line_tab + MI_LINE_FUNC_TAB;
+
+ first_line_item = (p + ftab_size + 1);
+ for (i = 0; i < ftab_size; i++) {
+ *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]);
+ }
+ *p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs);
+ ASSERT(p == first_line_item);
+ for (i = 0; i < num_instrs; i++) {
+ *p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos);
+ }
+ *p++ = (Eterm) (BeamInstr) (code + stp->ci - 1);
+
+ line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p;
+ memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm));
+ p += stp->num_fnames;
+
+ line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p;
+ line_tab[MI_LINE_LOC_SIZE] = stp->loc_size;
+ if (stp->loc_size == 2) {
+ Uint16* locp = (Uint16 *) p;
+ for (i = 0; i < num_instrs; i++) {
+ *locp++ = (Uint16) stp->line_instr[i].loc;
+ }
+ *locp++ = LINE_INVALID_LOCATION;
+ str_table = (byte *) locp;
+ } else {
+ Uint32* locp = (Uint32 *) p;
+ ASSERT(stp->loc_size == 4);
+ for (i = 0; i < num_instrs; i++) {
+ *locp++ = stp->line_instr[i].loc;
+ }
+ *locp++ = LINE_INVALID_LOCATION;
+ str_table = (byte *) locp;
+ }
- sys_memcpy(literal_end, stp->chunks[STR_CHUNK].start, strtab_size);
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ }
+
+ /*
+ * Place the string table and, optionally, attributes here.
+ */
+ sys_memcpy(str_table, stp->chunks[STR_CHUNK].start, strtab_size);
CHKBLK(ERTS_ALC_T_CODE,code);
- str_table = (byte *) literal_end;
if (attr_size) {
byte* attr = str_table + strtab_size;
sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size);
code[MI_ATTR_PTR] = (BeamInstr) attr;
code[MI_ATTR_SIZE] = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
- decoded_size = erts_decode_ext_size(attr, attr_size, 0);
+ decoded_size = erts_decode_ext_size(attr, attr_size);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of module attributes");
}
@@ -3706,7 +4164,7 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
CHKBLK(ERTS_ALC_T_CODE,code);
- decoded_size = erts_decode_ext_size(compile_info, compile_size, 0);
+ decoded_size = erts_decode_ext_size(compile_info, compile_size);
CHKBLK(ERTS_ALC_T_CODE,code);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of compilation information");
@@ -3723,20 +4181,8 @@ freeze_code(LoaderState* stp)
((byte *) code) + size);
/*
- * Go through all i_new_bs_put_strings instructions, restore the pointer to
- * the instruction and convert string offsets to pointers (to the
- * FIRST character).
+ * Patch all instructions that refer to the string table.
*/
-
- index = stp->new_bs_put_strings;
- while (index != 0) {
- Uint next = code[index];
- code[index] = BeamOpCode(op_bs_put_string_II);
- code[index+2] = (BeamInstr) (str_table + code[index+2]);
- index = next;
- }
- CHKBLK(ERTS_ALC_T_CODE,code);
-
{
StringPatch* sp = stp->string_patches;
@@ -3777,21 +4223,6 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
/*
- * Fix all catch_yf instructions.
- */
- index = stp->catches;
- catches = BEAM_CATCHES_NIL;
- while (index != 0) {
- BeamInstr next = code[index];
- code[index] = BeamOpCode(op_catch_yf);
- catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
- code[index+2] = make_catch(catches);
- index = next;
- }
- stp->catches = catches;
- CHKBLK(ERTS_ALC_T_CODE,code);
-
- /*
* Save the updated code pointer and code size.
*/
@@ -3816,6 +4247,26 @@ final_touch(LoaderState* stp)
{
int i;
int on_load = stp->on_load;
+ unsigned catches;
+ Uint index;
+ BeamInstr* code = stp->code;
+ Module* modp;
+
+ /*
+ * Allocate catch indices and fix up all catch_yf instructions.
+ */
+
+ index = stp->catches;
+ catches = BEAM_CATCHES_NIL;
+ while (index != 0) {
+ BeamInstr next = code[index];
+ code[index] = BeamOpCode(op_catch_yf);
+ catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
+ code[index+2] = make_catch(catches);
+ index = next;
+ }
+ modp = erts_put_module(stp->module);
+ modp->catches = catches;
/*
* Export functions.
@@ -3899,6 +4350,7 @@ transform_engine(LoaderState* st)
GenOp* instr;
Uint* pc;
int rval;
+ static Uint restart_fail[1] = {TOP_fail};
ASSERT(gen_opc[st->genop->op].transform != -1);
pc = op_transform + gen_opc[st->genop->op].transform;
@@ -3912,7 +4364,6 @@ transform_engine(LoaderState* st)
ASSERT(restart != NULL);
pc = restart;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail);
instr = st->genop;
#define RETURN(r) rval = (r); goto do_return;
@@ -3925,7 +4376,9 @@ transform_engine(LoaderState* st)
op = *pc++;
switch (op) {
- case TOP_is_op:
+ case TOP_next_instr:
+ instr = instr->next;
+ ap = 0;
if (instr == NULL) {
/*
* We'll need at least one more instruction to decide whether
@@ -4112,10 +4565,6 @@ transform_engine(LoaderState* st)
case TOP_next_arg:
ap++;
break;
- case TOP_next_instr:
- instr = instr->next;
- ap = 0;
- break;
case TOP_commit:
instr = instr->next; /* The next_instr was optimized away. */
@@ -4133,8 +4582,8 @@ transform_engine(LoaderState* st)
#endif
break;
-#if defined(TOP_call)
- case TOP_call:
+#if defined(TOP_call_end)
+ case TOP_call_end:
{
GenOp** lastp;
GenOp* new_instr;
@@ -4171,7 +4620,7 @@ transform_engine(LoaderState* st)
*lastp = st->genop;
st->genop = new_instr;
}
- break;
+ RETURN(TE_OK);
#endif
case TOP_new_instr:
/*
@@ -4180,12 +4629,10 @@ transform_engine(LoaderState* st)
NEW_GENOP(st, instr);
instr->next = st->genop;
st->genop = instr;
+ instr->op = op = *pc++;
+ instr->arity = gen_opc[op].arity;
ap = 0;
break;
- case TOP_store_op:
- instr->op = *pc++;
- instr->arity = *pc++;
- break;
case TOP_store_type:
i = *pc++;
instr->a[ap].type = i;
@@ -4195,21 +4642,25 @@ transform_engine(LoaderState* st)
i = *pc++;
instr->a[ap].val = i;
break;
- case TOP_store_var:
+ case TOP_store_var_next_arg:
i = *pc++;
ASSERT(i < TE_MAX_VARS);
instr->a[ap].type = var[i].type;
instr->a[ap].val = var[i].val;
+ ap++;
break;
case TOP_try_me_else:
restart = pc + 1;
restart += *pc++;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
break;
+ case TOP_try_me_else_fail:
+ restart = restart_fail;
+ break;
case TOP_end:
RETURN(TE_OK);
case TOP_fail:
- RETURN(TE_FAIL)
+ RETURN(TE_FAIL);
default:
ASSERT(0);
}
@@ -4532,6 +4983,8 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size)
lit->heap_size = heap_size;
lit->heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, heap_size*sizeof(Eterm));
lit->term = make_boxed(lit->heap);
+ lit->off_heap.first = 0;
+ lit->off_heap.overhead = 0;
*hpp = lit->heap;
return stp->num_literals++;
}
@@ -4810,17 +5263,24 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
return result;
}
-
/*
- * Returns a pointer to {module, function, arity}, or NULL if not found.
+ * Find a function from the given pc and fill information in
+ * the FunctionInfo struct. If the full_info is non-zero, fill
+ * in all available information (including location in the
+ * source code). If no function is found, the 'current' field
+ * will be set to NULL.
*/
-BeamInstr *
-find_function_from_pc(BeamInstr* pc)
+
+void
+erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
{
Range* low = modules;
Range* high = low + num_loaded_modules;
Range* mid = mid_module;
+ fi->current = NULL;
+ fi->needed = 5;
+ fi->loc = LINE_INVALID_LOCATION;
while (low < high) {
if (pc < mid->start) {
high = mid;
@@ -4837,26 +5297,160 @@ find_function_from_pc(BeamInstr* pc)
high1 = mid1;
} else if (pc < mid1[1]) {
mid_module = mid;
- return mid1[0]+2;
+ fi->current = mid1[0]+2;
+ if (full_info) {
+ BeamInstr** fp = (BeamInstr **) (mid->start +
+ MI_FUNCTIONS);
+ int idx = mid1 - fp;
+ lookup_loc(fi, pc, mid->start, idx);
+ }
+ return;
} else {
low1 = mid1 + 1;
}
}
- return NULL;
+ return;
}
mid = low + (high-low) / 2;
}
- return NULL;
+}
+
+static void
+lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx)
+{
+ Eterm* line = (Eterm *) modp[MI_LINE_TABLE];
+ Eterm* low;
+ Eterm* high;
+ Eterm* mid;
+ Eterm pc;
+
+ if (line == 0) {
+ return;
+ }
+
+ pc = (Eterm) (BeamInstr) orig_pc;
+ fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR];
+ low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx];
+ high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1];
+ while (high > low) {
+ mid = low + (high-low) / 2;
+ if (pc < mid[0]) {
+ high = mid;
+ } else if (pc < mid[1]) {
+ int file;
+ int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB];
+
+ if (line[MI_LINE_LOC_SIZE] == 2) {
+ Uint16* loc_table =
+ (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB];
+ fi->loc = loc_table[index];
+ } else {
+ Uint32* loc_table =
+ (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB];
+ ASSERT(line[MI_LINE_LOC_SIZE] == 4);
+ fi->loc = loc_table[index];
+ }
+ if (fi->loc == LINE_INVALID_LOCATION) {
+ return;
+ }
+ fi->needed += 3+2+3+2;
+ file = LOC_FILE(fi->loc);
+ if (file == 0) {
+ /* Special case: Module name with ".erl" appended */
+ Atom* mod_atom = atom_tab(atom_val(fi->current[0]));
+ fi->needed += 2*(mod_atom->len+4);
+ } else {
+ Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1]));
+ fi->needed += 2*ap->len;
+ }
+ return;
+ } else {
+ low = mid + 1;
+ }
+ }
+}
+
+/*
+ * Build a single {M,F,A,Loction} item to be part of
+ * a stack trace.
+ */
+Eterm*
+erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p)
+{
+ BeamInstr* current = fi->current;
+ Eterm loc = NIL;
+
+ if (fi->loc != LINE_INVALID_LOCATION) {
+ Eterm tuple;
+ int line = LOC_LINE(fi->loc);
+ int file = LOC_FILE(fi->loc);
+ Eterm file_term = NIL;
+
+ if (file == 0) {
+ Atom* ap = atom_tab(atom_val(fi->current[0]));
+ file_term = buf_to_intlist(&hp, ".erl", 4, NIL);
+ file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term);
+ } else {
+ Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1]));
+ file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, NIL);
+ }
+
+ tuple = TUPLE2(hp, am_line, make_small(line));
+ hp += 3;
+ loc = CONS(hp, tuple, loc);
+ hp += 2;
+ tuple = TUPLE2(hp, am_file, file_term);
+ hp += 3;
+ loc = CONS(hp, tuple, loc);
+ hp += 2;
+ }
+
+ if (is_list(args) || is_nil(args)) {
+ *mfa_p = TUPLE4(hp, current[0], current[1], args, loc);
+ } else {
+ Eterm arity = make_small(current[2]);
+ *mfa_p = TUPLE4(hp, current[0], current[1], arity, loc);
+ }
+ return hp + 5;
+}
+
+/*
+ * Force setting of the current function in a FunctionInfo
+ * structure. No source code location will be associated with
+ * the function.
+ */
+void
+erts_set_current_function(FunctionInfo* fi, BeamInstr* current)
+{
+ fi->current = current;
+ fi->needed = 5;
+ fi->loc = LINE_INVALID_LOCATION;
+}
+
+
+/*
+ * Returns a pointer to {module, function, arity}, or NULL if not found.
+ */
+BeamInstr*
+find_function_from_pc(BeamInstr* pc)
+{
+ FunctionInfo fi;
+
+ erts_lookup_function_info(&fi, pc, 0);
+ return fi.current;
}
/*
* Read a specific chunk from a Beam binary.
*/
-Eterm
-code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
+BIF_RETTYPE
+code_get_chunk_2(BIF_ALIST_2)
{
- LoaderState state;
+ Process* p = BIF_P;
+ Eterm Bin = BIF_ARG_1;
+ Eterm Chunk = BIF_ARG_2;
+ LoaderState* stp;
Uint chunk = 0;
ErlSubBin* sb;
Uint offset;
@@ -4868,15 +5462,16 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
Eterm real_bin;
byte* temp_alloc = NULL;
+ stp = erts_alloc_loader_state();
if ((start = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) {
error:
erts_free_aligned_binary_bytes(temp_alloc);
+ if (stp) {
+ free_state(stp);
+ }
BIF_ERROR(p, BADARG);
}
- state.module = THE_NON_VALUE; /* Suppress diagnostiscs */
- state.file_name = "IFF header for Beam file";
- state.file_p = start;
- state.file_left = binary_size(Bin);
+ stp->module = THE_NON_VALUE; /* Suppress diagnostics */
for (i = 0; i < 4; i++) {
Eterm* chunkp;
Eterm num;
@@ -4894,25 +5489,30 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
if (is_not_nil(Chunk)) {
goto error;
}
- if (!scan_iff_file(&state, &chunk, 1, 1)) {
- erts_free_aligned_binary_bytes(temp_alloc);
- return am_undefined;
+ if (!init_iff_file(stp, start, binary_size(Bin)) ||
+ !scan_iff_file(stp, &chunk, 1, 1) ||
+ stp->chunks[0].start == NULL) {
+ res = am_undefined;
+ goto done;
}
ERTS_GET_REAL_BIN(Bin, real_bin, offset, bitoffs, bitsize);
if (bitoffs) {
- res = new_binary(p, state.chunks[0].start, state.chunks[0].size);
+ res = new_binary(p, stp->chunks[0].start, stp->chunks[0].size);
} else {
sb = (ErlSubBin *) HAlloc(p, ERL_SUB_BIN_SIZE);
sb->thing_word = HEADER_SUB_BIN;
sb->orig = real_bin;
- sb->size = state.chunks[0].size;
+ sb->size = stp->chunks[0].size;
sb->bitsize = 0;
sb->bitoffs = 0;
- sb->offs = offset + (state.chunks[0].start - start);
+ sb->offs = offset + (stp->chunks[0].start - start);
sb->is_writable = 0;
res = make_binary(sb);
}
+
+ done:
erts_free_aligned_binary_bytes(temp_alloc);
+ free_state(stp);
return res;
}
@@ -4920,24 +5520,34 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
* Calculate the MD5 for a module.
*/
-Eterm
-code_module_md5_1(Process* p, Eterm Bin)
+BIF_RETTYPE
+code_module_md5_1(BIF_ALIST_1)
{
- LoaderState state;
+ Process* p = BIF_P;
+ Eterm Bin = BIF_ARG_1;
+ LoaderState* stp;
+ byte* bytes;
byte* temp_alloc = NULL;
+ Eterm res;
- if ((state.file_p = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) {
+ stp = erts_alloc_loader_state();
+ if ((bytes = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) {
+ free_state(stp);
BIF_ERROR(p, BADARG);
}
- state.module = THE_NON_VALUE; /* Suppress diagnostiscs */
- state.file_name = "IFF header for Beam file";
- state.file_left = binary_size(Bin);
-
- if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) {
- return am_undefined;
+ stp->module = THE_NON_VALUE; /* Suppress diagnostiscs */
+ if (!init_iff_file(stp, bytes, binary_size(Bin)) ||
+ !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !verify_chunks(stp)) {
+ res = am_undefined;
+ goto done;
}
+ res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5));
+
+ done:
erts_free_aligned_binary_bytes(temp_alloc);
- return new_binary(p, state.mod_md5, sizeof(state.mod_md5));
+ free_state(stp);
+ return res;
}
#define WORDS_PER_FUNCTION 6
@@ -4972,7 +5582,7 @@ stub_copy_info(LoaderState* stp,
if (size != 0) {
memcpy(info, stp->chunks[chunk].start, size);
*ptr_word = (BeamInstr) info;
- decoded_size = erts_decode_ext_size(info, size, 0);
+ decoded_size = erts_decode_ext_size(info, size);
if (decoded_size < 0) {
return 0;
}
@@ -5179,7 +5789,17 @@ patch_funentries(Eterm Patchlist)
fe = erts_get_fun_entry(Mod, uniq, index);
fe->native_address = (Uint *)native_address;
- erts_refc_dec(&fe->refc, 1);
+
+ /* Deliberate MEMORY LEAK of native fun entries!!!
+ *
+ * Uncomment line below when hipe code upgrade and purging works correctly.
+ * Today we may get cases when old (leaked) native code of a purged module
+ * gets called and tries to create instances of a deleted fun entry.
+ *
+ * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge
+ *
+ * erts_refc_dec(&fe->refc, 1);
+ */
if (!patch(Addresses, (Uint) fe))
return 0;
@@ -5200,7 +5820,7 @@ patch_funentries(Eterm Patchlist)
Eterm
erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
{
- LoaderState state;
+ LoaderState* stp;
BeamInstr Funcs;
BeamInstr Patchlist;
Eterm* tp;
@@ -5213,16 +5833,15 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
int code_size;
int rval;
int i;
- ErlDrvBinary* bin = NULL;
byte* temp_alloc = NULL;
byte* bytes;
Uint size;
/*
- * Must initialize state.lambdas here because the error handling code
+ * Must initialize stp->lambdas here because the error handling code
* at label 'error' uses it.
*/
- init_state(&state);
+ stp = erts_alloc_loader_state();
if (is_not_atom(Mod)) {
goto error;
@@ -5246,47 +5865,35 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
size = binary_size(Beam);
/*
- * Uncompressed if needed.
- */
- if (!(size >= 4 && bytes[0] == 'F' && bytes[1] == 'O' &&
- bytes[2] == 'R' && bytes[3] == '1')) {
- bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)bytes, size);
- if (bin == NULL) {
- goto error;
- }
- bytes = (byte*)bin->orig_bytes;
- size = bin->orig_size;
- }
-
- /*
* Scan the Beam binary and read the interesting sections.
*/
- state.file_name = "IFF header for Beam file";
- state.file_p = bytes;
- state.file_left = size;
- state.module = Mod;
- state.group_leader = p->group_leader;
- state.num_functions = n;
- if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) {
+ stp->module = Mod;
+ stp->group_leader = p->group_leader;
+ stp->num_functions = n;
+ if (!init_iff_file(stp, bytes, size)) {
+ goto error;
+ }
+ if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !verify_chunks(stp)) {
goto error;
}
- define_file(&state, "code chunk header", CODE_CHUNK);
- if (!read_code_header(&state)) {
+ define_file(stp, "code chunk header", CODE_CHUNK);
+ if (!read_code_header(stp)) {
goto error;
}
- define_file(&state, "atom table", ATOM_CHUNK);
- if (!load_atom_table(&state)) {
+ define_file(stp, "atom table", ATOM_CHUNK);
+ if (!load_atom_table(stp)) {
goto error;
}
- define_file(&state, "export table", EXP_CHUNK);
- if (!stub_read_export_table(&state)) {
+ define_file(stp, "export table", EXP_CHUNK);
+ if (!stub_read_export_table(stp)) {
goto error;
}
- if (state.chunks[LAMBDA_CHUNK].size > 0) {
- define_file(&state, "lambda (fun) table", LAMBDA_CHUNK);
- if (!read_lambda_table(&state)) {
+ if (stp->chunks[LAMBDA_CHUNK].size > 0) {
+ define_file(stp, "lambda (fun) table", LAMBDA_CHUNK);
+ if (!read_lambda_table(stp)) {
goto error;
}
}
@@ -5296,8 +5903,8 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
*/
code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr);
- code_size += state.chunks[ATTR_CHUNK].size;
- code_size += state.chunks[COMPILE_CHUNK].size;
+ code_size += stp->chunks[ATTR_CHUNK].size;
+ code_size += stp->chunks[COMPILE_CHUNK].size;
code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
if (!code) {
goto error;
@@ -5315,6 +5922,9 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
code[MI_COMPILE_SIZE] = 0;
code[MI_COMPILE_SIZE_ON_HEAP] = 0;
code[MI_NUM_BREAKPOINTS] = 0;
+ code[MI_LITERALS_START] = 0;
+ code[MI_LITERALS_END] = 0;
+ code[MI_LITERALS_OFF_HEAP] = 0;
code[MI_ON_LOAD_FUNCTION_PTR] = 0;
ci = MI_FUNCTIONS + n + 1;
@@ -5387,12 +5997,12 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
*/
info = (byte *) fp;
- info = stub_copy_info(&state, ATTR_CHUNK, info,
+ info = stub_copy_info(stp, ATTR_CHUNK, info,
code+MI_ATTR_PTR, code+MI_ATTR_SIZE_ON_HEAP);
if (info == NULL) {
goto error;
}
- info = stub_copy_info(&state, COMPILE_CHUNK, info,
+ info = stub_copy_info(stp, COMPILE_CHUNK, info,
code+MI_COMPILE_PTR, code+MI_COMPILE_SIZE_ON_HEAP);
if (info == NULL) {
goto error;
@@ -5402,9 +6012,8 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Insert the module in the module table.
*/
- rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size,
- BEAM_CATCHES_NIL);
- if (rval < 0) {
+ rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size);
+ if (rval != NIL) {
goto error;
}
@@ -5414,46 +6023,19 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
fp = code + ci;
for (i = 0; i < n; i++) {
- stub_final_touch(&state, fp);
+ stub_final_touch(stp, fp);
fp += WORDS_PER_FUNCTION;
}
if (patch_funentries(Patchlist)) {
erts_free_aligned_binary_bytes(temp_alloc);
- if (state.lambdas != state.def_lambdas) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas);
- }
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels);
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom);
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export);
- if (bin != NULL) {
- driver_free_binary(bin);
- }
+ free_state(stp);
return Mod;
}
error:
erts_free_aligned_binary_bytes(temp_alloc);
- if (code != NULL) {
- erts_free(ERTS_ALC_T_CODE, code);
- }
- if (state.labels != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels);
- }
- if (state.lambdas != state.def_lambdas) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas);
- }
- if (state.atom != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom);
- }
- if (state.export != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export);
- }
- if (bin != NULL) {
- driver_free_binary(bin);
- }
-
-
+ free_state(stp);
BIF_ERROR(p, BADARG);
}
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index 26e3054c4b..4e22ee4d79 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -23,7 +23,9 @@
#include "beam_opcodes.h"
#include "erl_process.h"
-int beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module);
+Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm module);
+
typedef struct gen_op_entry {
char* name;
@@ -101,11 +103,18 @@ extern Uint erts_total_code_size;
*/
#define MI_LITERALS_START 8
#define MI_LITERALS_END 9
+#define MI_LITERALS_OFF_HEAP 10
+
/*
* Pointer to the on_load function (or NULL if none).
*/
-#define MI_ON_LOAD_FUNCTION_PTR 10
+#define MI_ON_LOAD_FUNCTION_PTR 11
+
+/*
+ * Pointer to the line table (or NULL if none).
+ */
+#define MI_LINE_TABLE 12
/*
* Start of function pointer table. This table contains pointers to
@@ -116,5 +125,5 @@ extern Uint erts_total_code_size;
* this table.
*/
-#define MI_FUNCTIONS 11
+#define MI_FUNCTIONS 13
#endif /* _BEAM_LOAD_H */
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 07fdd809f8..f5616af95e 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1106,9 +1106,9 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3)
/**********************************************************************/
-BIF_RETTYPE get_stacktrace_0(Process* p)
+BIF_RETTYPE get_stacktrace_0(BIF_ALIST_0)
{
- Eterm t = build_stacktrace(p, p->ftrace);
+ Eterm t = build_stacktrace(BIF_P, BIF_P->ftrace);
BIF_RET(t);
}
@@ -1118,10 +1118,10 @@ BIF_RETTYPE get_stacktrace_0(Process* p)
* the process, and the final error value will be {Term,StackTrace}.
*/
-BIF_RETTYPE error_1(Process* p, Eterm term)
+BIF_RETTYPE error_1(BIF_ALIST_1)
{
- p->fvalue = term;
- BIF_ERROR(p, EXC_ERROR);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, EXC_ERROR);
}
/**********************************************************************/
@@ -1130,12 +1130,12 @@ BIF_RETTYPE error_1(Process* p, Eterm term)
* in the stacktrace.
*/
-BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args)
+BIF_RETTYPE error_2(BIF_ALIST_2)
{
- Eterm* hp = HAlloc(p, 3);
+ Eterm* hp = HAlloc(BIF_P, 3);
- p->fvalue = TUPLE2(hp, value, args);
- BIF_ERROR(p, EXC_ERROR_2);
+ BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
+ BIF_ERROR(BIF_P, EXC_ERROR_2);
}
/**********************************************************************/
@@ -1145,10 +1145,10 @@ BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args)
* It is useful in stub functions for NIFs.
*/
-BIF_RETTYPE nif_error_1(Process* p, Eterm term)
+BIF_RETTYPE nif_error_1(BIF_ALIST_1)
{
- p->fvalue = term;
- BIF_ERROR(p, EXC_ERROR);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, EXC_ERROR);
}
/**********************************************************************/
@@ -1158,12 +1158,12 @@ BIF_RETTYPE nif_error_1(Process* p, Eterm term)
* It is useful in stub functions for NIFs.
*/
-BIF_RETTYPE nif_error_2(Process* p, Eterm value, Eterm args)
+BIF_RETTYPE nif_error_2(BIF_ALIST_2)
{
- Eterm* hp = HAlloc(p, 3);
+ Eterm* hp = HAlloc(BIF_P, 3);
- p->fvalue = TUPLE2(hp, value, args);
- BIF_ERROR(p, EXC_ERROR_2);
+ BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
+ BIF_ERROR(BIF_P, EXC_ERROR_2);
}
/**********************************************************************/
@@ -1182,14 +1182,19 @@ BIF_RETTYPE exit_1(BIF_ALIST_1)
* If there is an error in the argument format,
* return the atom 'badarg' instead.
*/
-Eterm
-raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
+BIF_RETTYPE raise_3(BIF_ALIST_3)
+{
+ Process *c_p = BIF_P;
+ Eterm class = BIF_ARG_1;
+ Eterm value = BIF_ARG_2;
+ Eterm stacktrace = BIF_ARG_3;
Eterm reason;
Eterm l, *hp, *hp_end, *tp;
int depth, cnt;
size_t sz;
+ int must_copy = 0;
struct StackTrace *s;
-
+
if (class == am_error) {
c_p->fvalue = value;
reason = EXC_ERROR;
@@ -1205,35 +1210,74 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
/* Check syntax of stacktrace, and count depth.
* Accept anything that can be returned from erlang:get_stacktrace/0,
* as well as a 2-tuple with a fun as first element that the
- * error_handler may need to give us.
+ * error_handler may need to give us. Also allow old-style
+ * MFA three-tuples.
*/
for (l = stacktrace, depth = 0;
is_list(l);
l = CDR(list_val(l)), depth++) {
Eterm t = CAR(list_val(l));
- int arity;
+ Eterm location = NIL;
+
if (is_not_tuple(t)) goto error;
tp = tuple_val(t);
- arity = arityval(tp[0]);
- if ((arity == 3) && is_atom(tp[1]) && is_atom(tp[2])) continue;
- if ((arity == 2) && is_fun(tp[1])) continue;
- goto error;
+ switch (arityval(tp[0])) {
+ case 2:
+ /* {Fun,Args} */
+ if (is_fun(tp[1])) {
+ must_copy = 1;
+ } else {
+ goto error;
+ }
+ break;
+ case 3:
+ /*
+ * One of:
+ * {Fun,Args,Location}
+ * {M,F,A}
+ */
+ if (is_fun(tp[1])) {
+ location = tp[3];
+ } else if (is_atom(tp[1]) && is_atom(tp[2])) {
+ must_copy = 1;
+ } else {
+ goto error;
+ }
+ break;
+ case 4:
+ if (!(is_atom(tp[1]) && is_atom(tp[2]))) {
+ goto error;
+ }
+ location = tp[4];
+ break;
+ default:
+ goto error;
+ }
+ if (is_not_list(location) && is_not_nil(location)) {
+ goto error;
+ }
}
if (is_not_nil(l)) goto error;
/* Create stacktrace and store */
- if (depth <= erts_backtrace_depth) {
+ if (erts_backtrace_depth < depth) {
+ depth = erts_backtrace_depth;
+ must_copy = 1;
+ }
+ if (must_copy) {
+ cnt = depth;
+ c_p->ftrace = NIL;
+ } else {
+ /* No need to copy the stacktrace */
cnt = 0;
c_p->ftrace = stacktrace;
- } else {
- cnt = depth = erts_backtrace_depth;
- c_p->ftrace = NIL;
}
+
tp = &c_p->ftrace;
sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm) - 1)
/ sizeof(Eterm);
- hp = HAlloc(c_p, sz + 2*(cnt + 1));
- hp_end = hp + sz + 2*(cnt + 1);
+ hp = HAlloc(c_p, sz + (2+6)*(cnt + 1));
+ hp_end = hp + sz + (2+6)*(cnt + 1);
s = (struct StackTrace *) hp;
s->header = make_neg_bignum_header(sz - 1);
s->freason = reason;
@@ -1241,13 +1285,29 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
s->current = NULL;
s->depth = 0;
hp += sz;
- if (cnt > 0) {
+ if (must_copy) {
+ int cnt;
+
/* Copy list up to depth */
for (cnt = 0, l = stacktrace;
cnt < depth;
cnt++, l = CDR(list_val(l))) {
+ Eterm t;
+ Eterm *tpp;
+ int arity;
+
ASSERT(*tp == NIL);
- *tp = CONS(hp, CAR(list_val(l)), *tp);
+ t = CAR(list_val(l));
+ tpp = tuple_val(t);
+ arity = arityval(tpp[0]);
+ if (arity == 2) {
+ t = TUPLE3(hp, tpp[1], tpp[2], NIL);
+ hp += 4;
+ } else if (arity == 3 && is_atom(tpp[1])) {
+ t = TUPLE4(hp, tpp[1], tpp[2], tpp[3], NIL);
+ hp += 5;
+ }
+ *tp = CONS(hp, t, *tp);
tp = &CDR(list_val(*tp));
hp += 2;
}
@@ -1255,7 +1315,7 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
c_p->ftrace = CONS(hp, c_p->ftrace, make_big((Eterm *) s));
hp += 2;
ASSERT(hp <= hp_end);
-
+ HRelease(c_p, hp_end, hp);
BIF_ERROR(c_p, reason);
error:
@@ -1671,10 +1731,10 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1)
* erlang:'!'/2
*/
-Eterm
-ebif_bang_2(Process* p, Eterm To, Eterm Message)
+BIF_RETTYPE
+ebif_bang_2(BIF_ALIST_2)
{
- return send_2(p, To, Message);
+ return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
}
@@ -2011,8 +2071,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) {
}
-Eterm
-send_3(Process *p, Eterm to, Eterm msg, Eterm opts) {
+BIF_RETTYPE send_3(BIF_ALIST_3)
+{
+ Process *p = BIF_P;
+ Eterm to = BIF_ARG_1;
+ Eterm msg = BIF_ARG_2;
+ Eterm opts = BIF_ARG_3;
+
int connect = !0;
int suspend = !0;
Eterm l = opts;
@@ -2076,8 +2141,13 @@ send_3(Process *p, Eterm to, Eterm msg, Eterm opts) {
BIF_ERROR(p, BADARG);
}
-Eterm
-send_2(Process *p, Eterm to, Eterm msg) {
+BIF_RETTYPE send_2(BIF_ALIST_2)
+{
+ return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+Eterm erl_send(Process *p, Eterm to, Eterm msg)
+{
Sint result = do_send(p, to, msg, !0);
if (result > 0) {
@@ -3253,8 +3323,11 @@ time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day,
/* return the universal time */
BIF_RETTYPE
-localtime_to_universaltime_2(Process *p, Eterm localtime, Eterm dst)
+localtime_to_universaltime_2(BIF_ALIST_2)
{
+ Process *p = BIF_P;
+ Eterm localtime = BIF_ARG_1;
+ Eterm dst = BIF_ARG_2;
Sint year, month, day;
Sint hour, minute, second;
int isdst;
@@ -3503,9 +3576,10 @@ BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1)
}
-Eterm
-display_string_1(Process* p, Eterm string)
+BIF_RETTYPE display_string_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm string = BIF_ARG_1;
int len = is_string(string);
char *str;
@@ -3521,8 +3595,7 @@ display_string_1(Process* p, Eterm string)
BIF_RET(am_true);
}
-Eterm
-display_nl_0(Process* p)
+BIF_RETTYPE display_nl_0(BIF_ALIST_0)
{
erts_fprintf(stderr, "\n");
BIF_RET(am_true);
@@ -3586,8 +3659,13 @@ BIF_RETTYPE function_exported_3(BIF_ALIST_3)
/**********************************************************************/
-BIF_RETTYPE is_builtin_3(Process* p, Eterm Mod, Eterm Name, Eterm Arity)
+BIF_RETTYPE is_builtin_3(BIF_ALIST_3)
{
+ Process* p = BIF_P;
+ Eterm Mod = BIF_ARG_1;
+ Eterm Name = BIF_ARG_2;
+ Eterm Arity = BIF_ARG_3;
+
if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) {
BIF_ERROR(p, BADARG);
}
@@ -3652,9 +3730,11 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3)
BIF_RET(make_export(hp));
}
-Eterm
-fun_to_list_1(Process* p, Eterm fun)
+BIF_RETTYPE fun_to_list_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm fun = BIF_ARG_1;
+
if (is_not_any_fun(fun))
BIF_ERROR(p, BADARG);
BIF_RET(term2list_dsprintf(p, fun));
@@ -3992,7 +4072,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
erts_backtrace_depth = n;
BIF_RET(make_small(oval));
} else if (BIF_ARG_1 == am_trace_control_word) {
- BIF_RET(db_set_trace_control_word_1(BIF_P, BIF_ARG_2));
+ BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2));
} else if (BIF_ARG_1 == am_sequential_tracer) {
Eterm old_value = erts_set_system_seq_tracer(BIF_P,
ERTS_PROC_LOCK_MAIN,
@@ -4232,8 +4312,7 @@ void
erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret)
{
if (skip_current_msgq(c_p)) {
- Eterm unused;
- ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret);
+ ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret);
}
}
@@ -4241,8 +4320,7 @@ void
erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid)
{
if (skip_current_msgq(c_p)) {
- Eterm unused;
- ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p,
+ ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p,
pid, am_reason, am_undefined);
}
}
@@ -4257,7 +4335,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
{
ASSERT(is_atom(module) && is_atom(function));
if (skip_current_msgq(c_p)) {
- Eterm unused;
Eterm term;
Eterm *hp;
int i;
@@ -4269,7 +4346,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
hp += 2;
}
term = TUPLE3(hp, module, function, term);
- ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term);
+ ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term);
}
}
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index 8faa09feb8..d20089a9fb 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -26,14 +26,14 @@ extern Export* erts_format_cpu_topology_trap;
#define BIF_P A__p
-#define BIF_ALIST_0 Process* A__p
-#define BIF_ALIST_1 Process* A__p, Eterm A_1
-#define BIF_ALIST_2 Process* A__p, Eterm A_1, Eterm A_2
-#define BIF_ALIST_3 Process* A__p, Eterm A_1, Eterm A_2, Eterm A_3
+#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS
-#define BIF_ARG_1 A_1
-#define BIF_ARG_2 A_2
-#define BIF_ARG_3 A_3
+#define BIF_ARG_1 (BIF__ARGS[0])
+#define BIF_ARG_2 (BIF__ARGS[1])
+#define BIF_ARG_3 (BIF__ARGS[2])
#define BUMP_ALL_REDS(p) do { \
if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \
@@ -122,89 +122,106 @@ do { \
} while (0)
-#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \
-do { \
- (Proc)->arity = 0; \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
- (Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
+#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \
+do { \
+ (Proc)->arity = 0; \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
} while (0)
-#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \
-do { \
- (Proc)->arity = 1; \
- (Proc)->def_arg_reg[0] = (Eterm) (A0); \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
- (Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
+#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->arity = 1; \
+ reg[0] = (Eterm) (A0); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
} while (0)
-#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \
-do { \
- (Proc)->arity = 2; \
- (Proc)->def_arg_reg[0] = (Eterm) (A0); \
- (Proc)->def_arg_reg[1] = (Eterm) (A1); \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
- (Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
+#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->arity = 2; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->arity = 3; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
} while (0)
-#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2)\
+#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\
do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
(Proc)->arity = 3; \
- (Proc)->def_arg_reg[0] = (Eterm) (A0); \
- (Proc)->def_arg_reg[1] = (Eterm) (A1); \
- (Proc)->def_arg_reg[2] = (Eterm) (A2); \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
(Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
} while (0)
-#define BIF_TRAP0(p, Trap_) do { \
- (p)->arity = 0; \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP0(p, Trap_) do { \
+ (p)->arity = 0; \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP1(Trap_, p, A0) do { \
- (p)->arity = 1; \
- (p)->def_arg_reg[0] = (A0); \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP1(Trap_, p, A0) do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ (p)->arity = 1; \
+ reg[0] = (A0); \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP2(Trap_, p, A0, A1) do { \
- (p)->arity = 2; \
- (p)->def_arg_reg[0] = (A0); \
- (p)->def_arg_reg[1] = (A1); \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP2(Trap_, p, A0, A1) do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ (p)->arity = 2; \
+ reg[0] = (A0); \
+ reg[1] = (A1); \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \
- (p)->arity = 3; \
- (p)->def_arg_reg[0] = (A0); \
- (p)->def_arg_reg[1] = (A1); \
- (p)->def_arg_reg[2] = (A2); \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ (p)->arity = 3; \
+ reg[0] = (A0); \
+ reg[1] = (A1); \
+ reg[2] = (A2); \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \
- (p)->arity = 0; \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \
+ (p)->arity = 0; \
+ (p)->i = (BeamInstr*) (Code_); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP_CODE_PTR_(p, Code_) do { \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP_CODE_PTR_(p, Code_) do { \
+ (p)-> i = (BeamInstr*) (Code_); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
extern Export bif_return_trap_export;
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index d18de9ae5d..46db9ca99c 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -310,12 +310,12 @@
#define DREM(a1,a0,b,r) do { \
ErtsDigit __a1 = (a1); \
ErtsDigit __b = (b); \
- ErtsDigit __q0; \
+ ERTS_DECLARE_DUMMY(ErtsDigit __q0); \
DDIVREM((__a1 % __b), (a0), __b, __q0, r); \
} while(0)
#define DDIV(a1,a0,b,q) do { \
- ErtsDigit _tmp; \
+ ERTS_DECLARE_DUMMY(ErtsDigit _tmp); \
DDIVREM(a1,a0,b,q,_tmp); \
} while(0)
@@ -413,8 +413,8 @@
} while(0)
#define DDIV2(a1,a0,b1,b0,q) do { \
- ErtsDigit _tmp_r1; \
- ErtsDigit _tmp_r0; \
+ ERTS_DECLARE_DUMMY(ErtsDigit _tmp_r1); \
+ ERTS_DECLARE_DUMMY(ErtsDigit _tmp_r0); \
D2DIVREM(a1,a0,b1,b0,q,_tmp_r1,_tmp_r0); \
} while(0)
@@ -810,7 +810,9 @@ static dsize_t D_div(ErtsDigit* x, dsize_t xl, ErtsDigit d, ErtsDigit* q, ErtsDi
}
do {
- ErtsDigit q0, a0, b1, b0, b;
+ ErtsDigit q0, a0, b0;
+ ERTS_DECLARE_DUMMY(ErtsDigit b);
+ ERTS_DECLARE_DUMMY(ErtsDigit b1);
if (d > a1) {
a0 = *xp;
@@ -1584,6 +1586,62 @@ big_to_double(Wterm x, double* resp)
return 0;
}
+/*
+ * Logic has been copied from erl_bif_guard.c and slightly
+ * modified to use a static instead of dynamic heap
+ */
+Eterm
+double_to_big(double x, Eterm *heap)
+{
+ int is_negative;
+ int ds;
+ ErtsDigit* xp;
+ Eterm res;
+ int i;
+ size_t sz;
+ Eterm* hp;
+ double dbase;
+
+ if (x >= 0) {
+ is_negative = 0;
+ } else {
+ is_negative = 1;
+ x = -x;
+ }
+
+ /* Unscale & (calculate exponent) */
+ ds = 0;
+ dbase = ((double) (D_MASK) + 1);
+ while (x >= 1.0) {
+ x /= dbase; /* "shift" right */
+ ds++;
+ }
+ sz = BIG_NEED_SIZE(ds); /* number of words including arity */
+
+ hp = heap;
+ res = make_big(hp);
+ xp = (ErtsDigit*) (hp + 1);
+
+ for (i = ds - 1; i >= 0; i--) {
+ ErtsDigit d;
+
+ x *= dbase; /* "shift" left */
+ d = x; /* trunc */
+ xp[i] = d; /* store digit */
+ x -= d; /* remove integer part */
+ }
+ while ((ds & (BIG_DIGITS_PER_WORD - 1)) != 0) {
+ xp[ds++] = 0;
+ }
+
+ if (is_negative) {
+ *hp = make_neg_bignum_header(sz-1);
+ } else {
+ *hp = make_pos_bignum_header(sz-1);
+ }
+ return res;
+}
+
/*
** Estimate the number of decimal digits (include sign)
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index 2afc37004f..256f1c2b45 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -140,6 +140,7 @@ Eterm big_lshift(Eterm, Sint, Eterm*);
int big_comp (Wterm, Wterm);
int big_ucomp (Eterm, Eterm);
int big_to_double(Wterm x, double* resp);
+Eterm double_to_big(double, Eterm*);
Eterm small_to_big(Sint, Eterm*);
Eterm uint_to_big(Uint, Eterm*);
Eterm uword_to_big(UWord, Eterm*);
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index 1fb39c6c67..29461877c5 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -356,8 +356,10 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
{
Eterm bin;
Uint size;
- int offset;
byte* bytes;
+#ifdef DEBUG
+ int offset;
+#endif
if (is_nil(arg)) {
BIF_RET(new_binary(p,(byte*)"",0));
@@ -372,7 +374,11 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
}
bin = new_binary(p, (byte *)NULL, size);
bytes = binary_bytes(bin);
- offset = io_list_to_buf(arg, (char*) bytes, size);
+#ifdef DEBUG
+ offset =
+#endif
+ io_list_to_buf(arg, (char*) bytes, size);
+
ASSERT(offset == 0);
BIF_RET(bin);
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 8d37ae9f9b..784e55ecd2 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -95,7 +95,7 @@ process_killer(void)
erts_printf("(k)ill (n)ext (r)eturn:\n");
while(1) {
if ((j = sys_get_key(0)) <= 0)
- halt_0(0);
+ erl_exit(0, "");
switch(j) {
case 'k':
if (rp->status == P_WAITING) {
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 90201f3a90..1d968fb147 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -134,7 +134,7 @@ Uint size_object(Eterm obj)
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
- Uint offset; /* Not used. */
+ ERTS_DECLARE_DUMMY(Uint offset); /* Not used. */
Uint bitsize;
Uint bitoffs;
Uint extra_bytes;
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index d62eed21b4..44c5ba1e26 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -968,7 +968,7 @@ int erts_net_message(Port *prt,
res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache);
if (res >= 0)
- res = ctl_len = erts_decode_dist_ext_size(&ede, 0);
+ res = ctl_len = erts_decode_dist_ext_size(&ede);
else {
#ifdef ERTS_DIST_MSG_DBG
erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n");
@@ -2731,85 +2731,92 @@ BIF_RETTYPE is_alive_0(BIF_ALIST_0)
/**********************************************************************/
/* erlang:monitor_node(Node, Bool, Options) -> Bool */
-BIF_RETTYPE monitor_node_3(BIF_ALIST_3)
+static BIF_RETTYPE
+monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options)
{
DistEntry *dep;
ErtsLink *lnk;
Eterm l;
- for (l = BIF_ARG_3; l != NIL && is_list(l); l = CDR(list_val(l))) {
+ for (l = Options; l != NIL && is_list(l); l = CDR(list_val(l))) {
Eterm t = CAR(list_val(l));
/* allow_passive_connect the only available option right now */
if (t != am_allow_passive_connect) {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
}
if (l != NIL) {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- if (is_not_atom(BIF_ARG_1) ||
- ((BIF_ARG_2 != am_true) && (BIF_ARG_2 != am_false)) ||
+ if (is_not_atom(Node) ||
+ ((Bool != am_true) && (Bool != am_false)) ||
((erts_this_node->sysname == am_Noname)
- && (BIF_ARG_1 != erts_this_node->sysname))) {
- BIF_ERROR(BIF_P, BADARG);
+ && (Node != erts_this_node->sysname))) {
+ BIF_ERROR(p, BADARG);
}
- dep = erts_sysname_to_connected_dist_entry(BIF_ARG_1);
+ dep = erts_sysname_to_connected_dist_entry(Node);
if (!dep) {
do_trap:
- BIF_TRAP3(dmonitor_node_trap, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options);
}
if (dep == erts_this_dist_entry)
goto done;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
erts_smp_de_rlock(dep);
if (ERTS_DE_IS_NOT_CONNECTED(dep)) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
erts_smp_de_runlock(dep);
goto do_trap;
}
erts_smp_de_links_lock(dep);
erts_smp_de_runlock(dep);
- if (BIF_ARG_2 == am_true) {
+ if (Bool == am_true) {
ASSERT(dep->cid != NIL);
lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE,
- BIF_P->id);
+ p->id);
++ERTS_LINK_REFC(lnk);
- lnk = erts_add_or_lookup_link(&(BIF_P->nlinks), LINK_NODE, BIF_ARG_1);
+ lnk = erts_add_or_lookup_link(&(p->nlinks), LINK_NODE, Node);
++ERTS_LINK_REFC(lnk);
}
else {
- lnk = erts_lookup_link(dep->node_links, BIF_P->id);
+ lnk = erts_lookup_link(dep->node_links, p->id);
if (lnk != NULL) {
if ((--ERTS_LINK_REFC(lnk)) == 0) {
erts_destroy_link(erts_remove_link(&(dep->node_links),
- BIF_P->id));
+ p->id));
}
}
- lnk = erts_lookup_link(BIF_P->nlinks, BIF_ARG_1);
+ lnk = erts_lookup_link(p->nlinks, Node);
if (lnk != NULL) {
if ((--ERTS_LINK_REFC(lnk)) == 0) {
- erts_destroy_link(erts_remove_link(&(BIF_P->nlinks),
- BIF_ARG_1));
+ erts_destroy_link(erts_remove_link(&(p->nlinks),
+ Node));
}
}
}
erts_smp_de_links_unlock(dep);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
done:
erts_deref_dist_entry(dep);
BIF_RET(am_true);
}
+BIF_RETTYPE monitor_node_3(BIF_ALIST_3)
+{
+ BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3));
+}
+
+
/* monitor_node(Node, Bool) -> Bool */
BIF_RETTYPE monitor_node_2(BIF_ALIST_2)
{
- BIF_RET(monitor_node_3(BIF_P,BIF_ARG_1,BIF_ARG_2,NIL));
+ BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL));
}
BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1)
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 33d6cf5f2f..140a84d5fc 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -2758,16 +2758,18 @@ erts_allocator_options(void *proc)
void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size)
{
- UWord v = (UWord) erts_alloc(type, size + (ERTS_CACHE_LINE_SIZE-1));
+ UWord v = (UWord) erts_alloc(type, size + (ERTS_CACHE_LINE_SIZE-1)
+#ifdef VALGRIND
+ + sizeof(UWord)
+#endif
+ );
#ifdef VALGRIND
- { /* Avoid Leak_PossiblyLost */
- static UWord vg_root_set[10];
- static unsigned ix = 0;
- if (ix >= sizeof(vg_root_set) / sizeof(*vg_root_set)) {
- erl_exit(ERTS_ABORT_EXIT, "Too many erts_alloc_permanent_cache_aligned's\n");
- }
- vg_root_set[ix++] = v; /* not thread safe */
+ { /* Link them to avoid Leak_PossiblyLost */
+ static UWord* first_in_list = NULL;
+ *(UWord**)v = first_in_list;
+ first_in_list = (UWord*) v;
+ v += sizeof(UWord);
}
#endif
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index 64fad9fe0e..5150a8a507 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -164,14 +164,14 @@ BIF_RETTYPE bxor_2(BIF_ALIST_2)
BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2));
}
-BIF_RETTYPE bsl_2(Process* p, Eterm arg1, Eterm arg2)
+BIF_RETTYPE bsl_2(BIF_ALIST_2)
{
- BIF_RET(shift(p, arg1, arg2, 0));
+ BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 0));
}
-BIF_RETTYPE bsr_2(Process* p, Eterm arg1, Eterm arg2)
+BIF_RETTYPE bsr_2(BIF_ALIST_2)
{
- BIF_RET(shift(p, arg1, arg2, 1));
+ BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 1));
}
static Eterm
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 684fa5d12f..7e7bec9b87 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -65,6 +65,10 @@ static Export binary_copy_trap_export;
static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
static Uint max_loop_limit;
+static BIF_RETTYPE
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+static BIF_RETTYPE
+binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
void erts_init_bif_binary(void)
{
@@ -1148,7 +1152,7 @@ static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend,
erts_free_aligned_binary_bytes(temp_alloc);
return DO_BIN_MATCH_RESTART;
} else {
- Eterm epos = erts_make_integer(pos+hsstart,p);
+ Eterm epos = erts_make_integer(pos,p);
Eterm erlen = erts_make_integer(rlen,p);
hp = HAlloc(p,3);
ret = TUPLE2(hp, epos, erlen);
@@ -1399,6 +1403,12 @@ static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3)
BIF_RETTYPE binary_match_3(BIF_ALIST_3)
{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
Uint hsstart;
Uint hsend;
Eterm *tp;
@@ -1408,17 +1418,17 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
int runres;
Eterm result;
- if (is_not_binary(BIF_ARG_1)) {
+ if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) {
+ if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
goto badarg;
}
if (hsend == 0) {
BIF_RET(am_nomatch);
}
- if (is_tuple(BIF_ARG_2)) {
- tp = tuple_val(BIF_ARG_2);
+ if (is_tuple(arg2)) {
+ tp = tuple_val(arg2);
if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
goto badarg;
}
@@ -1437,13 +1447,13 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2,&type,&bin)) {
goto badarg;
}
- runres = do_binary_match(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,NIL,&result);
+ runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
- Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin);
+ Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
+ bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
@@ -1451,17 +1461,23 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
case DO_BIN_MATCH_OK:
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, bin_term);
+ BUMP_ALL_REDS(p);
+ BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term);
default:
goto badarg;
}
badarg:
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
{
+ return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
Uint hsstart, hsend;
Eterm *tp;
Eterm type;
@@ -1470,17 +1486,17 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
int runres;
Eterm result;
- if (is_not_binary(BIF_ARG_1)) {
+ if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) {
+ if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
goto badarg;
}
if (hsend == 0) {
BIF_RET(NIL);
}
- if (is_tuple(BIF_ARG_2)) {
- tp = tuple_val(BIF_ARG_2);
+ if (is_tuple(arg2)) {
+ tp = tuple_val(arg2);
if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
goto badarg;
}
@@ -1499,14 +1515,14 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2,&type,&bin)) {
goto badarg;
}
- runres = do_binary_matches(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,
+ runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin,
NIL,&result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
- Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin);
+ Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
+ bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
@@ -1514,26 +1530,26 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
case DO_BIN_MATCH_OK:
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result,
+ BUMP_ALL_REDS(p);
+ BIF_TRAP3(&binary_matches_trap_export, p, arg1, result,
bin_term);
default:
goto badarg;
}
badarg:
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
BIF_RETTYPE binary_match_2(BIF_ALIST_2)
{
- return binary_match_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
}
BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
{
- return binary_matches_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
}
@@ -1882,9 +1898,9 @@ static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction)
cd = (CommonData *) ERTS_MAGIC_BIN_DATA(mb);
l = list;
while (is_list(l)) {
- Uint bitoffs;
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
Uint bitsize;
- Uint offset;
+ ERTS_DECLARE_DUMMY(Uint offset);
Eterm real_bin;
ProcBin* pb;
@@ -2361,7 +2377,7 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
{
Uint n;
byte *bytes;
- Uint bit_offs;
+ ERTS_DECLARE_DUMMY(Uint bit_offs);
Uint bit_size;
size_t size;
Uint reds = get_reds(p, BINARY_COPY_LOOP_FACTOR);
@@ -2390,9 +2406,9 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
if ((target_size - size) >= reds) {
Eterm orig;
- Uint offset;
- Uint bit_offset;
- Uint bit_size;
+ ERTS_DECLARE_DUMMY(Uint offset);
+ ERTS_DECLARE_DUMMY(Uint bit_offset);
+ ERTS_DECLARE_DUMMY(Uint bit_size);
CopyBinState *cbs;
Eterm *hp;
Eterm trap_term;
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index d714eacd06..b2d5722e9b 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -142,9 +142,11 @@ static void ddll_no_more_references(void *vdh);
* really load and add as LOADED {ok,loaded} {ok,pending_driver}
* {error, permanent} {error,load_error()}
*/
-BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
- Eterm name_term, Eterm options)
+BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3)
{
+ Eterm path_term = BIF_ARG_1;
+ Eterm name_term = BIF_ARG_2;
+ Eterm options = BIF_ARG_3;
char *path = NULL;
Uint path_len;
char *name = NULL;
@@ -236,7 +238,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
sys_strcpy(path+path_len,name);
#if DDLL_SMP
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
#endif
if ((drv = lookup_driver(name)) != NULL) {
@@ -247,7 +249,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
} else {
dh = drv->handle;
if (dh->status == ERL_DE_OK) {
- int is_last = is_last_user(dh,p);
+ int is_last = is_last_user(dh, BIF_P);
if (reload == 1 && !is_last) {
/*Want reload if no other users,
but there are others...*/
@@ -261,7 +263,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
soft_error_term = am_inconsistent;
goto soft_error;
}
- if ((old = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) ==
+ if ((old = find_proc_entry(dh, BIF_P,
+ ERL_DE_PROC_LOADED)) ==
NULL) {
soft_error_term = am_not_loaded_by_this_process;
goto soft_error;
@@ -272,7 +275,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
}
/* Reload requested and granted */
dereference_all_processes(dh);
- set_driver_reloading(dh, p, path, name, flags);
+ set_driver_reloading(dh, BIF_P, path, name, flags);
if (dh->flags & ERL_DE_FL_KILL_PORTS) {
kill_ports = 1;
}
@@ -286,7 +289,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
soft_error_term = am_inconsistent;
goto soft_error;
}
- add_proc_loaded(dh,p);
+ add_proc_loaded(dh, BIF_P);
erts_ddll_reference_driver(dh);
monitor = 0;
ok_term = mkatom("already_loaded");
@@ -308,7 +311,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
notify_all(dh, drv->name,
ERL_DE_PROC_AWAIT_UNLOAD, am_UP,
am_unload_cancelled);
- add_proc_loaded(dh,p);
+ add_proc_loaded(dh, BIF_P);
erts_ddll_reference_driver(dh);
monitor = 0;
ok_term = mkatom("already_loaded");
@@ -325,7 +328,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
goto soft_error;
}
/* Load of granted unload... */
- add_proc_loaded_deref(dh,p); /* Dont reference, will happen after reload */
+ /* Don't reference, will happen after reload */
+ add_proc_loaded_deref(dh, BIF_P);
++monitor;
ok_term = am_pending_driver;
} else { /* ERL_DE_PERMANENT */
@@ -345,7 +349,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
goto soft_error;
} else {
dh->flags = flags;
- add_proc_loaded(dh,p);
+ add_proc_loaded(dh, BIF_P);
first_ddll_reference(dh);
monitor = 0;
ok_term = mkatom("loaded");
@@ -397,18 +401,18 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
#if DDLL_SMP
erts_ddll_reference_driver(dh);
unlock_drv_list();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
erts_ddll_dereference_driver(dh);
#endif
- p->flags |= F_USING_DDLL;
+ BIF_P->flags |= F_USING_DDLL;
if (monitor) {
- Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_LOAD);
- hp = HAlloc(p,4);
+ Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_LOAD);
+ hp = HAlloc(BIF_P, 4);
t = TUPLE3(hp, am_ok, ok_term, mref);
} else {
- hp = HAlloc(p,3);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_ok, ok_term);
}
#if DDLL_SMP
@@ -416,33 +420,33 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
BIF_RET(t);
soft_error:
#if DDLL_SMP
unlock_drv_list();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
#endif
if (do_build_load_error) {
- soft_error_term = build_load_error(p, build_this_load_error);
+ soft_error_term = build_load_error(BIF_P, build_this_load_error);
}
- hp = HAlloc(p,3);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_error, soft_error_term);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
BIF_RET(t);
error:
assert_drv_list_not_locked();
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
if (path != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
}
if (name != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
}
- BIF_ERROR(p,BADARG);
+ BIF_ERROR(BIF_P, BADARG);
}
/*
@@ -481,8 +485,10 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
any AWAIT_LOAD-waiters with {'DOWN', ref(), driver, name(), load_cancelled}
If the driver made itself permanent, {'UP', ref(), driver, name(), permanent}
*/
-Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options)
+Eterm erl_ddll_try_unload_2(BIF_ALIST_2)
{
+ Eterm name_term = BIF_ARG_1;
+ Eterm options = BIF_ARG_2;
char *name = NULL;
Eterm ok_term = NIL;
Eterm soft_error_term = NIL;
@@ -495,7 +501,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options)
Eterm l;
int kill_ports = 0;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
for(l = options; is_list(l); l = CDR(list_val(l))) {
Eterm opt = CAR(list_val(l));
@@ -548,7 +554,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options)
if (dh->flags & ERL_DE_FL_KILL_PORTS) {
kill_ports = 1;
}
- if ((pe = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == NULL) {
+ if ((pe = find_proc_entry(dh, BIF_P, ERL_DE_PROC_LOADED)) == NULL) {
if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) {
soft_error_term = am_not_loaded_by_this_process;
goto soft_error;
@@ -624,22 +630,22 @@ done:
#if DDLL_SMP
erts_ddll_reference_driver(dh);
unlock_drv_list();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
erts_ddll_dereference_driver(dh);
#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- p->flags |= F_USING_DDLL;
+ BIF_P->flags |= F_USING_DDLL;
if (monitor > 0) {
- Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_UNLOAD);
- hp = HAlloc(p,4);
+ Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_UNLOAD);
+ hp = HAlloc(BIF_P, 4);
t = TUPLE3(hp, am_ok, ok_term, mref);
} else {
- hp = HAlloc(p,3);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_ok, ok_term);
}
if (kill_ports > 1) {
- ERTS_BIF_CHK_EXITED(p); /* May be exited by port killing */
+ ERTS_BIF_CHK_EXITED(BIF_P); /* May be exited by port killing */
}
#if DDLL_SMP
unlock_drv_list();
@@ -651,8 +657,8 @@ soft_error:
unlock_drv_list();
#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- hp = HAlloc(p,3);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_error, soft_error_term);
BIF_RET(t);
@@ -661,21 +667,21 @@ soft_error:
if (name != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
}
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- BIF_ERROR(p,BADARG);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ BIF_ERROR(BIF_P, BADARG);
}
/*
* A shadow of the "real" demonitor BIF
*/
-BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref)
+BIF_RETTYPE erl_ddll_demonitor_1(BIF_ALIST_1)
{
- if (is_not_internal_ref(ref)) {
- BIF_ERROR(p, BADARG);
+ if (is_not_internal_ref(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P, BADARG);
}
- if (p->flags & F_USING_DDLL) {
- erts_ddll_remove_monitor(p, ref, ERTS_PROC_LOCK_MAIN);
+ if (BIF_P->flags & F_USING_DDLL) {
+ erts_ddll_remove_monitor(BIF_P, BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
}
@@ -683,18 +689,18 @@ BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref)
/*
* A shadow of the "real" monitor BIF
*/
-BIF_RETTYPE erl_ddll_monitor_2(Process *p, Eterm dr, Eterm what)
+BIF_RETTYPE erl_ddll_monitor_2(BIF_ALIST_2)
{
- if (dr != am_driver) {
- BIF_ERROR(p,BADARG);
+ if (BIF_ARG_1 != am_driver) {
+ BIF_ERROR(BIF_P, BADARG);
}
- return erts_ddll_monitor_driver(p, what, ERTS_PROC_LOCK_MAIN);
+ return erts_ddll_monitor_driver(BIF_P, BIF_ARG_2, ERTS_PROC_LOCK_MAIN);
}
/*
* Return list of loaded drivers {ok,[string()]}
*/
-Eterm erl_ddll_loaded_drivers_0(Process *p)
+BIF_RETTYPE erl_ddll_loaded_drivers_0(BIF_ALIST_0)
{
Eterm *hp;
int need = 3;
@@ -706,7 +712,7 @@ Eterm erl_ddll_loaded_drivers_0(Process *p)
for (drv = driver_list; drv; drv = drv->next) {
need += sys_strlen(drv->name)*2+2;
}
- hp = HAlloc(p,need);
+ hp = HAlloc(BIF_P, need);
for (drv = driver_list; drv; drv = drv->next) {
Eterm l;
l = buf_to_intlist(&hp, drv->name, sys_strlen(drv->name), NIL);
@@ -726,8 +732,11 @@ Eterm erl_ddll_loaded_drivers_0(Process *p)
* item is processes, driver_options, port_count, linked_in_driver,
* permanent, awaiting_load, awaiting_unload
*/
-Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item)
+BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
{
+ Process *p = BIF_P;
+ Eterm name_term = BIF_ARG_1;
+ Eterm item = BIF_ARG_2;
char *name = NULL;
Eterm res = NIL;
erts_driver_t *drv;
@@ -850,8 +859,10 @@ Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item)
* Backend for erl_ddll:format_error, handles all "soft" errors returned by builtins,
* possibly by calling the system specific error handler
*/
-Eterm erl_ddll_format_error_int_1(Process *p, Eterm code_term)
+BIF_RETTYPE erl_ddll_format_error_int_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm code_term = BIF_ARG_1;
char *errstring = NULL;
int errint;
int len;
@@ -1558,14 +1569,14 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
if ((res = erts_sys_ddll_load_driver_init(dh->handle,
&init_handle)) != ERL_DE_NO_ERROR) {
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_NO_INIT;
+ res = ERL_DE_LOAD_ERROR_NO_INIT;
+ goto error;
}
dp = erts_sys_ddll_call_init(init_handle);
if (dp == NULL) {
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_FAILED_INIT;
+ res = ERL_DE_LOAD_ERROR_FAILED_INIT;
+ goto error;
}
switch (dp->extended_marker) {
@@ -1583,24 +1594,27 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
|| dp->handle2 != NULL
|| dp->process_exit != NULL) {
/* Old driver; needs to be recompiled... */
- return ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ goto error;
}
break;
case ERL_DRV_EXTENDED_MARKER:
if (ERL_DRV_EXTENDED_MAJOR_VERSION != dp->major_version
|| ERL_DRV_EXTENDED_MINOR_VERSION < dp->minor_version) {
/* Incompatible driver version */
- return ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ goto error;
}
break;
default:
/* Old driver; needs to be recompiled... */
- return ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ goto error;
}
if (strcmp(name, dp->driver_name) != 0) {
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_BAD_NAME;
+ res = ERL_DE_LOAD_ERROR_BAD_NAME;
+ goto error;
}
erts_smp_atomic_init_nob(&(dh->refc), (erts_aint_t) 0);
dh->port_count = 0;
@@ -1615,11 +1629,14 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
*/
erts_free(ERTS_ALC_T_DDLL_HANDLE, dh->full_path);
dh->full_path = NULL;
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_FAILED_INIT;
+ res = ERL_DE_LOAD_ERROR_FAILED_INIT;
+ goto error;
}
-
return ERL_DE_NO_ERROR;
+
+error:
+ erts_sys_ddll_close(dh->handle);
+ return res;
}
static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name)
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index c50537078b..db04fe5a54 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -123,6 +123,16 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE
# define PERFMON_GETPCR _IOR('P', 2, unsigned long long)
#endif
+/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */
+static Eterm os_type_tuple;
+static Eterm os_version_tuple;
+
+static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item);
+
+static Eterm
+current_function(Process* p, Process* rp, Eterm** hpp, int full_info);
+static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp);
+
static Eterm
bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
{
@@ -558,6 +568,8 @@ static Eterm pi_args[] = {
am_suspending,
am_min_heap_size,
am_min_bin_vheap_size,
+ am_current_location,
+ am_current_stacktrace,
#ifdef HYBRID
am_message_binary
#endif
@@ -606,8 +618,10 @@ pi_arg2ix(Eterm arg)
case am_suspending: return 26;
case am_min_heap_size: return 27;
case am_min_bin_vheap_size: return 28;
+ case am_current_location: return 29;
+ case am_current_stacktrace: return 30;
#ifdef HYBRID
- case am_message_binary: return 29;
+ case am_message_binary: return 31;
#endif
default: return -1;
}
@@ -1010,35 +1024,15 @@ process_info_aux(Process *BIF_P,
break;
case am_current_function:
- if (rp->current == NULL) {
- rp->current = find_function_from_pc(rp->i);
- }
- if (rp->current == NULL) {
- hp = HAlloc(BIF_P, 3);
- res = am_undefined;
- } else {
- BeamInstr* current;
-
- if (rp->current[0] == am_erlang &&
- rp->current[1] == am_process_info &&
- (rp->current[2] == 1 || rp->current[2] == 2) &&
- (current = find_function_from_pc(rp->cp)) != NULL) {
-
- /*
- * The current function is erlang:process_info/2,
- * which is not the answer that the application want.
- * We will use the function pointed into by rp->cp
- * instead.
- */
+ res = current_function(BIF_P, rp, &hp, 0);
+ break;
- rp->current = current;
- }
+ case am_current_location:
+ res = current_function(BIF_P, rp, &hp, 1);
+ break;
- hp = HAlloc(BIF_P, 3+4);
- res = TUPLE3(hp, rp->current[0],
- rp->current[1], make_small(rp->current[2]));
- hp += 4;
- }
+ case am_current_stacktrace:
+ res = current_stacktrace(BIF_P, rp, &hp);
break;
case am_initial_call:
@@ -1612,6 +1606,113 @@ process_info_aux(Process *BIF_P,
}
#undef MI_INC
+static Eterm
+current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
+{
+ Eterm* hp;
+ Eterm res;
+ FunctionInfo fi;
+
+ if (rp->current == NULL) {
+ erts_lookup_function_info(&fi, rp->i, full_info);
+ rp->current = fi.current;
+ } else if (full_info) {
+ erts_lookup_function_info(&fi, rp->i, full_info);
+ if (fi.current == NULL) {
+ /* Use the current function without location info */
+ erts_set_current_function(&fi, rp->current);
+ }
+ }
+
+ if (BIF_P->id == rp->id) {
+ FunctionInfo fi2;
+
+ /*
+ * The current function is erlang:process_info/{1,2},
+ * which is not the answer that the application want.
+ * We will use the function pointed into by rp->cp
+ * instead if it can be looked up.
+ */
+ erts_lookup_function_info(&fi2, rp->cp, full_info);
+ if (fi2.current) {
+ fi = fi2;
+ rp->current = fi2.current;
+ }
+ }
+
+ /*
+ * Return the result.
+ */
+ if (rp->current == NULL) {
+ hp = HAlloc(BIF_P, 3);
+ res = am_undefined;
+ } else if (full_info) {
+ hp = HAlloc(BIF_P, 3+fi.needed);
+ hp = erts_build_mfa_item(&fi, hp, am_true, &res);
+ } else {
+ hp = HAlloc(BIF_P, 3+4);
+ res = TUPLE3(hp, rp->current[0],
+ rp->current[1], make_small(rp->current[2]));
+ hp += 4;
+ }
+ *hpp = hp;
+ return res;
+}
+
+static Eterm
+current_stacktrace(Process* p, Process* rp, Eterm** hpp)
+{
+ Uint sz;
+ struct StackTrace* s;
+ int depth;
+ FunctionInfo* stk;
+ FunctionInfo* stkp;
+ Uint heap_size;
+ int i;
+ Eterm* hp = *hpp;
+ Eterm mfa;
+ Eterm res = NIL;
+
+ depth = 8;
+ sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth;
+ s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz);
+ s->depth = 0;
+ if (rp->i) {
+ s->trace[s->depth++] = rp->i;
+ depth--;
+ }
+ if (depth > 0 && rp->cp != 0) {
+ s->trace[s->depth++] = rp->cp - 1;
+ depth--;
+ }
+ erts_save_stacktrace(rp, s, depth);
+
+ depth = s->depth;
+ stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
+ depth*sizeof(FunctionInfo));
+ heap_size = 3;
+ for (i = 0; i < depth; i++) {
+ erts_lookup_function_info(stkp, s->trace[i], 1);
+ if (stkp->current) {
+ heap_size += stkp->needed + 2;
+ stkp++;
+ }
+ }
+
+ hp = HAlloc(p, heap_size);
+ while (stkp > stk) {
+ stkp--;
+ hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
+ res = CONS(hp, mfa, res);
+ hp += 2;
+ }
+
+ erts_free(ERTS_ALC_T_TMP, stk);
+ erts_free(ERTS_ALC_T_TMP, s);
+ *hpp = hp;
+ return res;
+}
+
#if defined(VALGRIND)
static int check_if_xml(void)
{
@@ -2028,7 +2129,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_undefined);
#endif
} else if (BIF_ARG_1 == am_trace_control_word) {
- BIF_RET(db_get_trace_control_word_0(BIF_P));
+ BIF_RET(db_get_trace_control_word(BIF_P));
} else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) {
BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false);
} else if (ERTS_IS_ATOM_STR("ets_always_compress", BIF_ARG_1)) {
@@ -2155,16 +2256,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
return erts_instr_get_type_info(BIF_P);
}
else if (BIF_ARG_1 == am_os_type) {
- Eterm type = am_atom_put(os_type, strlen(os_type));
- Eterm flav, tup;
- char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
-
- os_flavor(buf, 1024);
- flav = am_atom_put(buf, strlen(buf));
- hp = HAlloc(BIF_P, 3);
- tup = TUPLE2(hp, type, flav);
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- BIF_RET(tup);
+ BIF_RET(os_type_tuple);
}
else if (BIF_ARG_1 == am_allocator) {
BIF_RET(erts_allocator_options((void *) BIF_P));
@@ -2190,16 +2282,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_false);
}
else if (BIF_ARG_1 == am_os_version) {
- int major, minor, build;
- Eterm tup;
-
- os_version(&major, &minor, &build);
- hp = HAlloc(BIF_P, 4);
- tup = TUPLE3(hp,
- make_small(major),
- make_small(minor),
- make_small(build));
- BIF_RET(tup);
+ BIF_RET(os_version_tuple);
}
else if (BIF_ARG_1 == am_version) {
int n = strlen(ERLANG_VERSION);
@@ -2647,9 +2730,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
-Eterm
-port_info_1(Process* p, Eterm pid)
+BIF_RETTYPE
+port_info_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm pid = BIF_ARG_1;
static Eterm keys[] = {
am_name,
am_links,
@@ -2672,7 +2757,7 @@ port_info_1(Process* p, Eterm pid)
for (i = 0; i < ASIZE(keys); i++) {
Eterm item;
- item = port_info_2(p, pid, keys[i]);
+ item = port_info(p, pid, keys[i]);
if (is_non_value(item)) {
return THE_NON_VALUE;
}
@@ -2681,7 +2766,7 @@ port_info_1(Process* p, Eterm pid)
}
items[i] = item;
}
- reg_name = port_info_2(p, pid, am_registered_name);
+ reg_name = port_info(p, pid, am_registered_name);
/*
* Build the resulting list.
@@ -2717,24 +2802,27 @@ port_info_1(Process* p, Eterm pid)
BIF_RETTYPE port_info_2(BIF_ALIST_2)
{
+ return port_info(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item)
+{
BIF_RETTYPE ret;
- Eterm portid = BIF_ARG_1;
Port *prt;
- Eterm item = BIF_ARG_2;
Eterm res;
Eterm* hp;
int count;
if (is_internal_port(portid))
- prt = erts_id2port(portid, BIF_P, ERTS_PROC_LOCK_MAIN);
+ prt = erts_id2port(portid, p, ERTS_PROC_LOCK_MAIN);
else if (is_atom(portid))
- erts_whereis_name(BIF_P, ERTS_PROC_LOCK_MAIN,
+ erts_whereis_name(p, ERTS_PROC_LOCK_MAIN,
portid, NULL, 0, 0, &prt);
else if (is_external_port(portid)
&& external_port_dist_entry(portid) == erts_this_dist_entry)
BIF_RET(am_undefined);
else {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
if (!prt) {
@@ -2742,7 +2830,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
}
if (item == am_id) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = make_small(internal_port_number(portid));
}
else if (item == am_links) {
@@ -2754,10 +2842,10 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_links(prt->nlinks, &collect_one_link, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ hp = HAlloc(p, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity);
res = CONS(hp, item, res);
hp += 2;
}
@@ -2773,11 +2861,11 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_monitors(prt->monitors, &collect_one_origin_monitor, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ hp = HAlloc(p, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
Eterm t;
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity);
t = TUPLE2(hp, am_process, item);
hp += 3;
res = CONS(hp, t, res);
@@ -2789,25 +2877,25 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
else if (item == am_name) {
count = sys_strlen(prt->name);
- hp = HAlloc(BIF_P, 3 + 2*count);
+ hp = HAlloc(p, 3 + 2*count);
res = buf_to_intlist(&hp, prt->name, count, NIL);
}
else if (item == am_connected) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = prt->connected; /* internal pid */
}
else if (item == am_input) {
Uint hsz = 3;
Uint n = prt->bytes_in;
(void) erts_bld_uint(NULL, &hsz, n);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, n);
}
else if (item == am_output) {
Uint hsz = 3;
Uint n = prt->bytes_out;
(void) erts_bld_uint(NULL, &hsz, n);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, n);
}
else if (item == am_registered_name) {
@@ -2817,7 +2905,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
ERTS_BIF_PREP_RET(ret, NIL);
goto done;
} else {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = reg->name;
}
}
@@ -2829,7 +2917,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
Uint size = 0;
ErlHeapFragment* bp;
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
erts_doforall_links(prt->nlinks, &one_link_size, &size);
@@ -2846,18 +2934,18 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
hard to retrieve... */
(void) erts_bld_uint(NULL, &hsz, size);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, size);
}
else if (item == am_queue_size) {
Uint ioq_size = erts_port_ioq_size(prt);
Uint hsz = 3;
(void) erts_bld_uint(NULL, &hsz, ioq_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, ioq_size);
}
else if (ERTS_IS_ATOM_STR("locking", item)) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
#ifndef ERTS_SMP
res = am_false;
#else
@@ -2876,7 +2964,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
#endif
}
else {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(ret, p, BADARG);
goto done;
}
@@ -2890,9 +2978,12 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
}
-Eterm
-fun_info_2(Process* p, Eterm fun, Eterm what)
+BIF_RETTYPE
+fun_info_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm fun = BIF_ARG_1;
+ Eterm what = BIF_ARG_2;
Eterm* hp;
Eterm val;
@@ -4042,6 +4133,27 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+static void os_info_init(void)
+{
+ Eterm type = am_atom_put(os_type, strlen(os_type));
+ Eterm flav;
+ int major, minor, build;
+ char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
+ Eterm* hp;
+
+ os_flavor(buf, 1024);
+ flav = am_atom_put(buf, strlen(buf));
+ erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm));
+ os_type_tuple = TUPLE2(hp, type, flav);
+ hp += 3;
+ os_version(&major, &minor, &build);
+ os_version_tuple = TUPLE3(hp,
+ make_small(major),
+ make_small(minor),
+ make_small(build));
+}
+
void
erts_bif_info_init(void)
{
@@ -4051,4 +4163,5 @@ erts_bif_info_init(void)
alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1);
alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1);
process_info_init();
+ os_info_init();
}
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c
index 47c48e74d6..1805366cfe 100644
--- a/erts/emulator/beam/erl_bif_lists.c
+++ b/erts/emulator/beam/erl_bif_lists.c
@@ -34,27 +34,7 @@
static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List);
-/*
- * erlang:'++'/2
- */
-
-Eterm
-ebif_plusplus_2(Process* p, Eterm A, Eterm B)
-{
- return append_2(p, A, B);
-}
-
-/*
- * erlang:'--'/2
- */
-
-Eterm
-ebif_minusminus_2(Process* p, Eterm A, Eterm B)
-{
- return subtract_2(p, A, B);
-}
-
-BIF_RETTYPE append_2(BIF_ALIST_2)
+static BIF_RETTYPE append(Process* p, Eterm A, Eterm B)
{
Eterm list;
Eterm copy;
@@ -63,18 +43,18 @@ BIF_RETTYPE append_2(BIF_ALIST_2)
Eterm* hp;
int i;
- if ((i = list_length(BIF_ARG_1)) < 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((i = list_length(A)) < 0) {
+ BIF_ERROR(p, BADARG);
}
if (i == 0) {
- BIF_RET(BIF_ARG_2);
- } else if (is_nil(BIF_ARG_2)) {
- BIF_RET(BIF_ARG_1);
+ BIF_RET(B);
+ } else if (is_nil(B)) {
+ BIF_RET(A);
}
need = 2*i;
- hp = HAlloc(BIF_P, need);
- list = BIF_ARG_1;
+ hp = HAlloc(p, need);
+ list = A;
copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2));
list = CDR(list_val(list));
hp += 2;
@@ -85,12 +65,31 @@ BIF_RETTYPE append_2(BIF_ALIST_2)
list = CDR(listp);
hp += 2;
}
- CDR(list_val(last)) = BIF_ARG_2;
+ CDR(list_val(last)) = B;
BIF_RET(copy);
}
+/*
+ * erlang:'++'/2
+ */
+
+Eterm
+ebif_plusplus_2(BIF_ALIST_2)
+{
+ return append(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+BIF_RETTYPE append_2(BIF_ALIST_2)
+{
+ return append(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+/*
+ * erlang:'--'/2
+ */
+
#define SMALL_VEC_SIZE 10
-BIF_RETTYPE subtract_2(BIF_ALIST_2)
+static Eterm subtract(Process* p, Eterm A, Eterm B)
{
Eterm list;
Eterm* hp;
@@ -103,17 +102,17 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
int n;
int m;
- if ((n = list_length(BIF_ARG_1)) < 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((n = list_length(A)) < 0) {
+ BIF_ERROR(p, BADARG);
}
- if ((m = list_length(BIF_ARG_2)) < 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((m = list_length(B)) < 0) {
+ BIF_ERROR(p, BADARG);
}
if (n == 0)
BIF_RET(NIL);
if (m == 0)
- BIF_RET(BIF_ARG_1);
+ BIF_RET(A);
/* allocate element vector */
if (n <= SMALL_VEC_SIZE)
@@ -123,7 +122,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
/* PUT ALL ELEMENTS IN VP */
vp = vec_p;
- list = BIF_ARG_1;
+ list = A;
i = n;
while(i--) {
Eterm* listp = list_val(list);
@@ -132,7 +131,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
}
/* UNMARK ALL DELETED CELLS */
- list = BIF_ARG_2;
+ list = B;
m = 0; /* number of deleted elements */
while(is_list(list)) {
Eterm* listp = list_val(list);
@@ -153,11 +152,11 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
if (m == n) /* All deleted ? */
res = NIL;
else if (m == 0) /* None deleted ? */
- res = BIF_ARG_1;
+ res = A;
else { /* REBUILD LIST */
res = NIL;
need = 2*(n - m);
- hp = HAlloc(BIF_P, need);
+ hp = HAlloc(p, need);
vp = vec_p + n - 1;
while(vp >= vec_p) {
if (is_value(*vp)) {
@@ -172,6 +171,16 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
BIF_RET(res);
}
+BIF_RETTYPE ebif_minusminus_2(BIF_ALIST_2)
+{
+ return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+BIF_RETTYPE subtract_2(BIF_ALIST_2)
+{
+ return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
BIF_RETTYPE lists_member_2(BIF_ALIST_2)
{
Eterm term;
@@ -278,11 +287,12 @@ BIF_RETTYPE lists_reverse_2(BIF_ALIST_2)
}
BIF_RETTYPE
-lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
+lists_keymember_3(BIF_ALIST_3)
{
Eterm res;
- res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List);
+ res = keyfind(BIF_lists_keymember_3, BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
if (is_value(res) && is_tuple(res)) {
return am_true;
} else {
@@ -291,23 +301,25 @@ lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
}
BIF_RETTYPE
-lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
+lists_keysearch_3(BIF_ALIST_3)
{
Eterm res;
- res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List);
+ res = keyfind(BIF_lists_keysearch_3, BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
if (is_non_value(res) || is_not_tuple(res)) {
return res;
} else { /* Tuple */
- Eterm* hp = HAlloc(p, 3);
+ Eterm* hp = HAlloc(BIF_P, 3);
return TUPLE2(hp, am_value, res);
}
}
BIF_RETTYPE
-lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
+lists_keyfind_3(BIF_ALIST_3)
{
- return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List);
+ return keyfind(BIF_lists_keyfind_3, BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
static Eterm
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
index deda7adc1f..13f8b1f63c 100644
--- a/erts/emulator/beam/erl_bif_op.c
+++ b/erts/emulator/beam/erl_bif_op.c
@@ -225,18 +225,23 @@ BIF_RETTYPE is_function_1(BIF_ALIST_1)
BIF_RETTYPE is_function_2(BIF_ALIST_2)
{
+ BIF_RET(erl_is_function(BIF_P, BIF_ARG_1, BIF_ARG_2));
+}
+
+Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2)
+{
Sint arity;
/*
* Verify argument 2 (arity); arity must be >= 0.
*/
- if (is_small(BIF_ARG_2)) {
- arity = signed_val(BIF_ARG_2);
+ if (is_small(arg2)) {
+ arity = signed_val(arg2);
if (arity < 0) {
error:
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- } else if (is_big(BIF_ARG_2) && !bignum_header_is_neg(*big_val(BIF_ARG_2))) {
+ } else if (is_big(arg2) && !bignum_header_is_neg(*big_val(arg2))) {
/* A positive bignum is OK, but can't possibly match. */
arity = -1;
} else {
@@ -244,20 +249,20 @@ BIF_RETTYPE is_function_2(BIF_ALIST_2)
goto error;
}
- if (is_fun(BIF_ARG_1)) {
- ErlFunThing* funp = (ErlFunThing *) fun_val(BIF_ARG_1);
+ if (is_fun(arg1)) {
+ ErlFunThing* funp = (ErlFunThing *) fun_val(arg1);
if (funp->arity == (Uint) arity) {
BIF_RET(am_true);
}
- } else if (is_export(BIF_ARG_1)) {
- Export* exp = (Export *) EXPAND_POINTER((export_val(BIF_ARG_1))[1]);
+ } else if (is_export(arg1)) {
+ Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]);
if (exp->code[2] == (Uint) arity) {
BIF_RET(am_true);
}
- } else if (is_tuple(BIF_ARG_1)) {
- Eterm* tp = tuple_val(BIF_ARG_1);
+ } else if (is_tuple(arg1)) {
+ Eterm* tp = tuple_val(arg1);
if (tp[0] == make_arityval(2) && is_atom(tp[1]) && is_atom(tp[2])) {
BIF_RET(am_true);
}
diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c
index 954b1f9729..58d48199fa 100644
--- a/erts/emulator/beam/erl_bif_os.c
+++ b/erts/emulator/beam/erl_bif_os.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2010. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -53,20 +53,18 @@ BIF_RETTYPE os_timestamp_0(BIF_ALIST_0)
}
-Eterm
-os_getpid_0(Process* p)
+BIF_RETTYPE os_getpid_0(BIF_ALIST_0)
{
char pid_string[21]; /* enough for a 64 bit number */
int n;
Eterm* hp;
sys_get_pid(pid_string); /* In sys.c */
n = sys_strlen(pid_string);
- hp = HAlloc(p, n*2);
+ hp = HAlloc(BIF_P, n*2);
BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL));
}
-Eterm
-os_getenv_0(Process* p)
+BIF_RETTYPE os_getenv_0(BIF_ALIST_0)
{
GETENV_STATE state;
char *cp;
@@ -80,7 +78,7 @@ os_getenv_0(Process* p)
ret = NIL;
while ((cp = getenv_string(&state)) != NULL) {
len = strlen(cp);
- hp = HAlloc(p, len*2+2);
+ hp = HAlloc(BIF_P, len*2+2);
str = buf_to_intlist(&hp, cp, len, NIL);
ret = CONS(hp, str, ret);
}
@@ -90,9 +88,11 @@ os_getenv_0(Process* p)
return ret;
}
-Eterm
-os_getenv_1(Process* p, Eterm key)
+
+BIF_RETTYPE os_getenv_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm key = BIF_ARG_1;
Eterm str;
int len, res;
char *key_str, *val;
@@ -145,9 +145,11 @@ os_getenv_1(Process* p, Eterm key)
BIF_RET(str);
}
-Eterm
-os_putenv_2(Process* p, Eterm key, Eterm value)
+BIF_RETTYPE os_putenv_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm key = BIF_ARG_1;
+ Eterm value = BIF_ARG_2;
char def_buf[1024];
char *buf = NULL;
int sep_ix, i, key_len, value_len, tot_len;
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index 3fd35dd963..6b8f1b21fd 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -48,6 +48,9 @@ static void free_args(char **);
char *erts_default_arg0 = "default";
+static BIF_RETTYPE
+port_call(Process* p, Eterm arg1, Eterm arg2, Eterm arg3);
+
BIF_RETTYPE open_port_2(BIF_ALIST_2)
{
int port_num;
@@ -117,11 +120,9 @@ id_or_name2port(Process *c_p, Eterm id)
#define ERTS_PORT_COMMAND_FLAG_FORCE (((Uint32) 1) << 0)
#define ERTS_PORT_COMMAND_FLAG_NOSUSPEND (((Uint32) 1) << 1)
-static BIF_RETTYPE do_port_command(Process *BIF_P,
- Eterm BIF_ARG_1,
- Eterm BIF_ARG_2,
- Eterm BIF_ARG_3,
- Uint32 flags)
+static BIF_RETTYPE
+do_port_command(Process *BIF_P, Eterm arg1, Eterm arg2, Eterm arg3,
+ Uint32 flags)
{
BIF_RETTYPE res;
Port *p;
@@ -135,7 +136,7 @@ static BIF_RETTYPE do_port_command(Process *BIF_P,
profile_runnable_proc(BIF_P, am_inactive);
}
- p = id_or_name2port(BIF_P, BIF_ARG_1);
+ p = id_or_name2port(BIF_P, arg1);
if (!p) {
if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
trace_virtual_sched(BIF_P, am_in);
@@ -172,13 +173,13 @@ static BIF_RETTYPE do_port_command(Process *BIF_P,
monitor_generic(BIF_P, am_busy_port, p->id);
}
ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_port_command_3], BIF_P,
- BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ arg1, arg2, arg3);
}
} else {
int wres;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
ERTS_SMP_CHK_NO_PROC_LOCKS;
- wres = erts_write_to_port(BIF_P->id, p, BIF_ARG_2);
+ wres = erts_write_to_port(BIF_P->id, p, arg2);
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (wres != 0) {
ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
@@ -237,11 +238,17 @@ BIF_RETTYPE port_command_3(BIF_ALIST_3)
BIF_RETTYPE port_call_2(BIF_ALIST_2)
{
- return port_call_3(BIF_P,BIF_ARG_1,make_small(0),BIF_ARG_2);
+ return port_call(BIF_P,BIF_ARG_1, make_small(0), BIF_ARG_2);
}
BIF_RETTYPE port_call_3(BIF_ALIST_3)
{
+ return port_call(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+port_call(Process* c_p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
Uint op;
Port *p;
Uint size;
@@ -266,15 +273,15 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
/* trace of port scheduling with virtual process descheduling
* lock wait
*/
- if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(BIF_P, am_out);
+ if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) {
+ trace_virtual_sched(c_p, am_out);
}
if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) {
- profile_runnable_proc(BIF_P, am_inactive);
+ profile_runnable_proc(c_p, am_inactive);
}
- p = id_or_name2port(BIF_P, BIF_ARG_1);
+ p = id_or_name2port(c_p, arg1);
if (!p) {
error:
if (port_resp != port_result &&
@@ -286,22 +293,22 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
/* Need to virtual schedule in the process if there
* was an error.
*/
- if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(BIF_P, am_in);
+ if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) {
+ trace_virtual_sched(c_p, am_in);
}
if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) {
- profile_runnable_proc(BIF_P, am_active);
+ profile_runnable_proc(c_p, am_active);
}
if (p)
erts_port_release(p);
#ifdef ERTS_SMP
- ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN);
#else
- ERTS_BIF_CHK_EXITED(BIF_P);
+ ERTS_BIF_CHK_EXITED(c_p);
#endif
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(c_p, BADARG);
}
if ((drv = p->drv_ptr) == NULL) {
@@ -310,10 +317,10 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (drv->call == NULL) {
goto error;
}
- if (!term_to_Uint(BIF_ARG_2, &op)) {
+ if (!term_to_Uint(arg2, &op)) {
goto error;
}
- p->caller = BIF_P->id;
+ p->caller = c_p->id;
/* Lock taken, virtual schedule of port */
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
@@ -323,19 +330,19 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) {
profile_runnable_port(p, am_active);
}
- size = erts_encode_ext_size(BIF_ARG_3);
+ size = erts_encode_ext_size(arg3);
if (size > sizeof(port_input))
bytes = erts_alloc(ERTS_ALC_T_PORT_CALL_BUF, size);
endp = bytes;
- erts_encode_ext(BIF_ARG_3, &endp);
+ erts_encode_ext(arg3, &endp);
real_size = endp - bytes;
if (real_size > size) {
erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
__FILE__, __LINE__, endp - (bytes + size));
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
prc = (char *) port_resp;
fpe_was_unmasked = erts_block_fpe();
ret = drv->call((ErlDrvData)p->drv_data,
@@ -356,7 +363,7 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
port_resp = (byte *) prc;
p->caller = NIL;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
#ifdef HARDDEBUG
{
int z;
@@ -378,18 +385,18 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
/* Error or a binary without magic/ with wrong magic */
goto error;
}
- result_size = erts_decode_ext_size(port_resp, ret, 0);
+ result_size = erts_decode_ext_size(port_resp, ret);
if (result_size < 0) {
goto error;
}
- hp = HAlloc(BIF_P, result_size);
+ hp = HAlloc(c_p, result_size);
hp_end = hp + result_size;
endp = port_resp;
- res = erts_decode_ext(&hp, &MSO(BIF_P), &endp);
+ res = erts_decode_ext(&hp, &MSO(c_p), &endp);
if (res == THE_NON_VALUE) {
goto error;
}
- HRelease(BIF_P, hp_end, hp);
+ HRelease(c_p, hp_end, hp);
if (port_resp != port_result && !(ret_flags & DRIVER_CALL_KEEP_BUFFER)) {
driver_free(port_resp);
}
@@ -398,16 +405,16 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (p)
erts_port_release(p);
#ifdef ERTS_SMP
- ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN);
#else
- ERTS_BIF_CHK_EXITED(BIF_P);
+ ERTS_BIF_CHK_EXITED(c_p);
#endif
- if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(BIF_P, am_in);
+ if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) {
+ trace_virtual_sched(c_p, am_in);
}
if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) {
- profile_runnable_proc(BIF_P, am_active);
+ profile_runnable_proc(c_p, am_active);
}
return res;
diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c
index 26891c4348..6b843d2e08 100644
--- a/erts/emulator/beam/erl_bif_re.c
+++ b/erts/emulator/beam/erl_bif_re.c
@@ -45,6 +45,7 @@ static Export *urun_trap_exportp = NULL;
static Export *ucompile_trap_exportp = NULL;
static BIF_RETTYPE re_exec_trap(BIF_ALIST_3);
+static BIF_RETTYPE re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
static void *erts_erts_pcre_malloc(size_t size) {
return erts_alloc(ERTS_ALC_T_RE_HEAP,size);
@@ -414,8 +415,8 @@ build_compile_result(Process *p, Eterm error_tag, pcre *result, int errcode, con
* Compile BIFs
*/
-BIF_RETTYPE
-re_compile_2(BIF_ALIST_2)
+static BIF_RETTYPE
+re_compile(Process* p, Eterm arg1, Eterm arg2)
{
Uint slen;
char *expr;
@@ -429,43 +430,49 @@ re_compile_2(BIF_ALIST_2)
int unicode = 0;
- if (parse_options(BIF_ARG_2,&options,NULL,&pflags,NULL,NULL)
+ if (parse_options(arg2,&options,NULL,&pflags,NULL,NULL)
< 0) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
if (pflags & PARSE_FLAG_UNIQUE_EXEC_OPT) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;
- if (pflags & PARSE_FLAG_UNICODE && !is_binary(BIF_ARG_1)) {
- BIF_TRAP2(ucompile_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2);
+ if (pflags & PARSE_FLAG_UNICODE && !is_binary(arg1)) {
+ BIF_TRAP2(ucompile_trap_exportp, p, arg1, arg2);
}
- if (erts_iolist_size(BIF_ARG_1, &slen)) {
- BIF_ERROR(BIF_P,BADARG);
+ if (erts_iolist_size(arg1, &slen)) {
+ BIF_ERROR(p,BADARG);
}
expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1);
- if (io_list_to_buf(BIF_ARG_1, expr, slen) != 0) {
+ if (io_list_to_buf(arg1, expr, slen) != 0) {
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
expr[slen]='\0';
result = erts_pcre_compile2(expr, options, &errcode,
&errstr, &errofset, default_table);
- ret = build_compile_result(BIF_P, am_error, result, errcode,
+ ret = build_compile_result(p, am_error, result, errcode,
errstr, errofset, unicode, 1);
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
BIF_RET(ret);
}
BIF_RETTYPE
+re_compile_2(BIF_ALIST_2)
+{
+ return re_compile(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+BIF_RETTYPE
re_compile_1(BIF_ALIST_1)
{
- return re_compile_2(BIF_P,BIF_ARG_1,NIL);
+ return re_compile(BIF_P, BIF_ARG_1, NIL);
}
/*
@@ -845,8 +852,8 @@ build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code)
/*
* The actual re:run/2,3 BIFs
*/
-BIF_RETTYPE
-re_run_3(BIF_ALIST_3)
+static BIF_RETTYPE
+re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
{
const pcre *code_tmp;
RestartContext restart;
@@ -865,15 +872,15 @@ re_run_3(BIF_ALIST_3)
Eterm capture[CAPSPEC_SIZE];
int is_list_cap;
- if (parse_options(BIF_ARG_3,&comp_options,&options,&pflags,&startoffset,capture)
+ if (parse_options(arg3,&comp_options,&options,&pflags,&startoffset,capture)
< 0) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
is_list_cap = ((pflags & PARSE_FLAG_CAPTURE_OPT) &&
(capture[CAPSPEC_TYPE] == am_list));
- if (is_not_tuple(BIF_ARG_2) || (arityval(*tuple_val(BIF_ARG_2)) != 4)) {
- if (is_binary(BIF_ARG_2) || is_list(BIF_ARG_2) || is_nil(BIF_ARG_2)) {
+ if (is_not_tuple(arg2) || (arityval(*tuple_val(arg2)) != 4)) {
+ if (is_binary(arg2) || is_list(arg2) || is_nil(arg2)) {
/* Compile from textual RE */
Uint slen;
char *expr;
@@ -884,19 +891,19 @@ re_run_3(BIF_ALIST_3)
int capture_count;
if (pflags & PARSE_FLAG_UNICODE &&
- (!is_binary(BIF_ARG_2) || !is_binary(BIF_ARG_1) ||
+ (!is_binary(arg2) || !is_binary(arg1) ||
(is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) {
- BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ BIF_TRAP3(urun_trap_exportp, p, arg1, arg2, arg3);
}
- if (erts_iolist_size(BIF_ARG_2, &slen)) {
- BIF_ERROR(BIF_P,BADARG);
+ if (erts_iolist_size(arg2, &slen)) {
+ BIF_ERROR(p,BADARG);
}
expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1);
- if (io_list_to_buf(BIF_ARG_2, expr, slen) != 0) {
+ if (io_list_to_buf(arg2, expr, slen) != 0) {
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
expr[slen]='\0';
result = erts_pcre_compile2(expr, comp_options, &errcode,
@@ -905,11 +912,11 @@ re_run_3(BIF_ALIST_3)
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
/* Compilation error gives badarg except in the compile
function */
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
if (pflags & PARSE_FLAG_GLOBAL) {
Eterm precompiled =
- build_compile_result(BIF_P, am_error,
+ build_compile_result(p, am_error,
result, errcode,
errstr, errofset,
(pflags &
@@ -917,13 +924,13 @@ re_run_3(BIF_ALIST_3)
0);
Eterm *hp,r;
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
- hp = HAlloc(BIF_P,4);
- /* BIF_ARG_2 is in the tuple just to make exceptions right */
- r = TUPLE3(hp,BIF_ARG_3,
+ hp = HAlloc(p,4);
+ /* arg2 is in the tuple just to make exceptions right */
+ r = TUPLE3(hp,arg3,
((pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) ?
am_true :
- am_false), BIF_ARG_2);
- BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, precompiled, r);
+ am_false), arg2);
+ BIF_TRAP3(grun_trap_exportp, p, arg1, precompiled, r);
}
erts_pcre_fullinfo(result, NULL, PCRE_INFO_SIZE, &code_size);
@@ -935,31 +942,31 @@ re_run_3(BIF_ALIST_3)
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
/*unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;*/
} else {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
} else {
if (pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
- tp = tuple_val(BIF_ARG_2);
+ tp = tuple_val(arg2);
if (tp[1] != am_re_pattern || is_not_small(tp[2]) ||
is_not_small(tp[3]) || is_not_binary(tp[4])) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
if (unsigned_val(tp[3]) &&
- (!is_binary(BIF_ARG_1) ||
+ (!is_binary(arg1) ||
(is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { /* unicode */
- BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2,
- BIF_ARG_3);
+ BIF_TRAP3(urun_trap_exportp, p, arg1, arg2,
+ arg3);
}
if (pflags & PARSE_FLAG_GLOBAL) {
Eterm *hp,r;
- hp = HAlloc(BIF_P,3);
- r = TUPLE2(hp,BIF_ARG_3,am_false);
- BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2,
+ hp = HAlloc(p,3);
+ r = TUPLE2(hp,arg3,am_false);
+ BIF_TRAP3(grun_trap_exportp, p, arg1, arg2,
r);
}
@@ -968,7 +975,7 @@ re_run_3(BIF_ALIST_3)
if ((code_tmp = (const pcre *)
erts_get_aligned_binary_bytes(tp[4], &temp_alloc)) == NULL) {
erts_free_aligned_binary_bytes(temp_alloc);
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size);
memcpy(restart.code, code_tmp, code_size);
@@ -980,7 +987,7 @@ re_run_3(BIF_ALIST_3)
restart.ovector = erts_alloc(ERTS_ALC_T_RE_SUBJECT, ovsize * sizeof(int));
restart.extra.flags = PCRE_EXTRA_TABLES | PCRE_EXTRA_LOOP_LIMIT;
restart.extra.tables = default_table;
- restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(BIF_P) * LOOP_FACTOR;
+ restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(p) * LOOP_FACTOR;
loop_limit_tmp = max_loop_limit; /* To lesser probability of race in debug
situation (erts_debug) */
if (restart.extra.loop_limit > loop_limit_tmp) {
@@ -996,7 +1003,7 @@ re_run_3(BIF_ALIST_3)
if ((restart.ret_info = build_capture(capture,restart.code)) == NULL) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code);
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
}
@@ -1004,7 +1011,7 @@ re_run_3(BIF_ALIST_3)
copying, also binary returns can be sub binaries in that case */
restart.flags = 0;
- if (is_binary(BIF_ARG_1)) {
+ if (is_binary(arg1)) {
Eterm real_bin;
Uint offset;
Eterm* bptr;
@@ -1012,9 +1019,9 @@ re_run_3(BIF_ALIST_3)
int bitsize;
ProcBin* pb;
- ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize);
+ ERTS_GET_REAL_BIN(arg1, real_bin, offset, bitoffs, bitsize);
- slength = binary_size(BIF_ARG_1);
+ slength = binary_size(arg1);
bptr = binary_val(real_bin);
if (bitsize != 0 || bitoffs != 0 || (*bptr != HEADER_PROC_BIN)) {
goto handle_iolist;
@@ -1027,24 +1034,24 @@ re_run_3(BIF_ALIST_3)
restart.flags |= RESTART_FLAG_SUBJECT_IN_BINARY;
} else {
handle_iolist:
- if (erts_iolist_size(BIF_ARG_1, &slength)) {
+ if (erts_iolist_size(arg1, &slength)) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code);
if (restart.ret_info != NULL) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info);
}
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
restart.subject = erts_alloc(ERTS_ALC_T_RE_SUBJECT, slength);
- if (io_list_to_buf(BIF_ARG_1, restart.subject, slength) != 0) {
+ if (io_list_to_buf(arg1, restart.subject, slength) != 0) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.subject);
if (restart.ret_info != NULL) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info);
}
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
}
@@ -1056,7 +1063,7 @@ handle_iolist:
rc = erts_pcre_exec(restart.code, &(restart.extra), restart.subject, slength, startoffset,
options, restart.ovector, ovsize);
ASSERT(loop_count != 0xFFFFFFFF);
- BUMP_REDS(BIF_P, loop_count / LOOP_FACTOR);
+ BUMP_REDS(p, loop_count / LOOP_FACTOR);
if (rc == PCRE_ERROR_LOOP_LIMIT) {
/* Trap */
Binary *mbp = erts_create_magic_binary(sizeof(RestartContext),
@@ -1065,17 +1072,17 @@ handle_iolist:
Eterm magic_bin;
Eterm *hp;
memcpy(restartp,&restart,sizeof(RestartContext));
- BUMP_ALL_REDS(BIF_P);
- hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- magic_bin = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mbp);
+ BUMP_ALL_REDS(p);
+ hp = HAlloc(p, PROC_BIN_SIZE);
+ magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp);
BIF_TRAP3(&re_exec_trap_export,
- BIF_P,
- BIF_ARG_1,
- BIF_ARG_2 /* To avoid GC of precompiled code, XXX: not utilized yet */,
+ p,
+ arg1,
+ arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */,
magic_bin);
}
- res = build_exec_return(BIF_P, rc, &restart, BIF_ARG_1);
+ res = build_exec_return(p, rc, &restart, arg1);
cleanup_restart_context(&restart);
@@ -1083,9 +1090,15 @@ handle_iolist:
}
BIF_RETTYPE
+re_run_3(BIF_ALIST_3)
+{
+ return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+BIF_RETTYPE
re_run_2(BIF_ALIST_2)
{
- return re_run_3(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL);
+ return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL);
}
/*
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 3e942dcc55..b0a58c80ea 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -48,6 +48,11 @@ static Binary *erts_default_meta_match_spec;
static struct trace_pattern_flags erts_default_trace_pattern_flags;
static Eterm erts_default_meta_tracer_pid;
+static Eterm
+trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist);
+static BIF_RETTYPE
+system_monitor(Process *p, Eterm monitor_pid, Eterm list);
+
static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/
static int already_traced(Process *p, Process *tracee_p, Eterm tracer);
static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer);
@@ -77,13 +82,19 @@ erts_bif_trace_init(void)
*/
Eterm
-trace_pattern_2(Process* p, Eterm MFA, Eterm Pattern)
+trace_pattern_2(BIF_ALIST_2)
{
- return trace_pattern_3(p,MFA,Pattern,NIL);
+ return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL);
}
Eterm
-trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
+trace_pattern_3(BIF_ALIST_3)
+{
+ return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static Eterm
+trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
{
DeclareTmpHeap(mfa,3,p); /* Not really heap here, but might be when setting pattern */
int i;
@@ -436,9 +447,12 @@ erts_trace_flags(Eterm List,
return 0;
}
-Eterm
-trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list)
+Eterm trace_3(BIF_ALIST_3)
{
+ Process* p = BIF_P;
+ Eterm pid_spec = BIF_ARG_1;
+ Eterm how = BIF_ARG_2;
+ Eterm list = BIF_ARG_3;
int on;
Eterm tracer = NIL;
int matches = 0;
@@ -821,9 +835,11 @@ static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer)
* Return information about a process or an external function being traced.
*/
-Eterm
-trace_info_2(Process* p, Eterm What, Eterm Key)
+Eterm trace_info_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm What = BIF_ARG_1;
+ Eterm Key = BIF_ARG_2;
Eterm res;
if (What == am_on_load) {
res = trace_info_on_load(p, Key);
@@ -1753,23 +1769,20 @@ new_seq_trace_token(Process* p)
}
}
-BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
+BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
{
- Eterm item;
Eterm res;
Eterm* hp;
Uint current_flag;
- if (is_not_atom(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
+ if (is_not_atom(item)) {
+ BIF_ERROR(p, BADARG);
}
- item = BIF_ARG_1;
-
- if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
+ if (SEQ_TRACE_TOKEN(p) == NIL) {
if ((item == am_send) || (item == am_receive) ||
(item == am_print) || (item == am_timestamp)) {
- hp = HAlloc(BIF_P,3);
+ hp = HAlloc(p,3);
res = TUPLE2(hp, item, am_false);
BIF_RET(res);
} else if ((item == am_label) || (item == am_serial)) {
@@ -1779,35 +1792,40 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
}
}
- if (BIF_ARG_1 == am_send) {
+ if (item == am_send) {
current_flag = SEQ_TRACE_SEND;
- } else if (BIF_ARG_1 == am_receive) {
+ } else if (item == am_receive) {
current_flag = SEQ_TRACE_RECEIVE;
- } else if (BIF_ARG_1 == am_print) {
+ } else if (item == am_print) {
current_flag = SEQ_TRACE_PRINT;
- } else if (BIF_ARG_1 == am_timestamp) {
+ } else if (item == am_timestamp) {
current_flag = SEQ_TRACE_TIMESTAMP;
} else {
current_flag = 0;
}
if (current_flag) {
- res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(BIF_P)) & current_flag ?
+ res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p)) & current_flag ?
am_true : am_false;
} else if (item == am_label) {
- res = SEQ_TRACE_TOKEN_LABEL(BIF_P);
+ res = SEQ_TRACE_TOKEN_LABEL(p);
} else if (item == am_serial) {
- hp = HAlloc(BIF_P, 3);
- res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(BIF_P), SEQ_TRACE_TOKEN_SERIAL(BIF_P));
+ hp = HAlloc(p, 3);
+ res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p), SEQ_TRACE_TOKEN_SERIAL(p));
} else {
error:
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = TUPLE2(hp, item, res);
BIF_RET(res);
}
+BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
+{
+ BIF_RET(erl_seq_trace_info(BIF_P, BIF_ARG_1));
+}
+
/*
seq_trace_print(Message) -> true | false
This function passes Message to the system_tracer
@@ -1920,23 +1938,35 @@ static Eterm system_monitor_get(Process *p)
}
-BIF_RETTYPE system_monitor_0(Process *p) {
- BIF_RET(system_monitor_get(p));
+BIF_RETTYPE system_monitor_0(BIF_ALIST_0)
+{
+ BIF_RET(system_monitor_get(BIF_P));
}
-BIF_RETTYPE system_monitor_1(Process *p, Eterm spec) {
+BIF_RETTYPE system_monitor_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm spec = BIF_ARG_1;
+
if (spec == am_undefined) {
- BIF_RET(system_monitor_2(p, spec, NIL));
+ BIF_RET(system_monitor(p, spec, NIL));
} else if (is_tuple(spec)) {
Eterm *tp = tuple_val(spec);
if (tp[0] != make_arityval(2)) goto error;
- BIF_RET(system_monitor_2(p, tp[1], tp[2]));
+ BIF_RET(system_monitor(p, tp[1], tp[2]));
}
error:
BIF_ERROR(p, BADARG);
}
-BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) {
+BIF_RETTYPE system_monitor_2(BIF_ALIST_2)
+{
+ return system_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE
+system_monitor(Process *p, Eterm monitor_pid, Eterm list)
+{
Eterm prev;
int system_blocked = 0;
@@ -2054,11 +2084,16 @@ static Eterm system_profile_get(Process *p) {
}
}
-BIF_RETTYPE system_profile_0(Process *p) {
- BIF_RET(system_profile_get(p));
+BIF_RETTYPE system_profile_0(BIF_ALIST_0)
+{
+ BIF_RET(system_profile_get(BIF_P));
}
-BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) {
+BIF_RETTYPE system_profile_2(BIF_ALIST_2)
+{
+ Process *p = BIF_P;
+ Eterm profiler = BIF_ARG_1;
+ Eterm list = BIF_ARG_2;
Eterm prev;
int system_blocked = 0;
Process *profiler_p = NULL;
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 326a5c136b..6f7309f493 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -845,8 +845,7 @@ erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm arg))
dst[1] = 0x80 | (val & 0x3F);
num_bits = 16;
} else if (val < 0x10000UL) {
- if ((0xD800 <= val && val <= 0xDFFF) ||
- val == 0xFFFE || val == 0xFFFF) {
+ if (0xD800 <= val && val <= 0xDFFF) {
return 0;
}
dst[0] = 0xE0 | (val >> 12);
@@ -886,8 +885,7 @@ erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm arg, Uint flags))
return 0;
}
val = unsigned_val(arg);
- if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF) ||
- val == 0xFFFE || val == 0xFFFF) {
+ if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF)) {
return 0;
}
@@ -1652,8 +1650,7 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb)
return THE_NON_VALUE;
}
result = (((result << 6) + a) << 6) + b - (Eterm) 0x000E2080UL;
- if ((0xD800 <= result && result <= 0xDFFF) ||
- result == 0xFFFE || result == 0xFFFF) {
+ if (0xD800 <= result && result <= 0xDFFF) {
return THE_NON_VALUE;
}
mb->offset += 24;
@@ -1723,9 +1720,6 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags)
w1 = (src[0] << 8) | src[1];
}
if (w1 < 0xD800 || w1 > 0xDFFF) {
- if (w1 == 0xFFFE || w1 == 0xFFFF) {
- return THE_NON_VALUE;
- }
mb->offset += 16;
return make_small(w1);
} else if (w1 > 0xDBFF) {
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 259ebd838e..38b4a2d460 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -129,8 +129,6 @@ static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed tab
static Uint meta_main_tab_seq_incr;
static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */
-
-
/*
** The meta hash table of all NAMED ets tables
*/
@@ -202,12 +200,17 @@ static int free_table_cont(Process *p,
int first,
int clean_meta_tab);
static void print_table(int to, void *to_arg, int show, DbTable* tb);
-static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1);
-static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1);
-static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1);
-static BIF_RETTYPE ets_delete_trap(Process *p, Eterm a1);
+static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1);
static Eterm table_info(Process* p, DbTable* tb, Eterm What);
+static BIF_RETTYPE ets_select1(Process* p, Eterm arg1);
+static BIF_RETTYPE ets_select2(Process* p, Eterm arg1, Eterm arg2);
+static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3);
+
+
/*
* Exported global
*/
@@ -1295,8 +1298,13 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
UWord heir_data;
Uint32 status;
Sint keypos;
- int is_named, is_fine_locked, frequent_read, is_compressed;
+ int is_named, is_compressed;
+#ifdef ERTS_SMP
+ int is_fine_locked, frequent_read;
+#endif
+#ifdef DEBUG
int cret;
+#endif
DeclareTmpHeap(meta_tuple,3,BIF_P);
DbTableMethod* meth;
erts_smp_rwmtx_t *mmtl;
@@ -1311,8 +1319,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
status = DB_NORMAL | DB_SET | DB_PROTECTED;
keypos = 1;
is_named = 0;
+#ifdef ERTS_SMP
is_fine_locked = 0;
frequent_read = 0;
+#endif
heir = am_none;
heir_data = (UWord) am_undefined;
is_compressed = erts_ets_always_compress;
@@ -1341,18 +1351,31 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
keypos = signed_val(tp[2]);
}
else if (tp[1] == am_write_concurrency) {
+#ifdef ERTS_SMP
if (tp[2] == am_true) {
is_fine_locked = 1;
} else if (tp[2] == am_false) {
is_fine_locked = 0;
} else break;
+#else
+ if ((tp[2] != am_true) && (tp[2] != am_false)) {
+ break;
+ }
+#endif
}
else if (tp[1] == am_read_concurrency) {
+#ifdef ERTS_SMP
if (tp[2] == am_true) {
frequent_read = 1;
} else if (tp[2] == am_false) {
frequent_read = 0;
} else break;
+#else
+ if ((tp[2] != am_true) && (tp[2] != am_false)) {
+ break;
+ }
+#endif
+
}
else if (tp[1] == am_heir && tp[2] == am_none) {
heir = am_none;
@@ -1392,11 +1415,11 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
}
if (IS_HASH_TABLE(status)) {
meth = &db_hash;
- #ifdef ERTS_SMP
+#ifdef ERTS_SMP
if (is_fine_locked && !(status & DB_PRIVATE)) {
status |= DB_FINE_LOCKED;
}
- #endif
+#endif
}
else if (IS_TREE_TABLE(status)) {
meth = &db_tree;
@@ -1444,7 +1467,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
tb->common.fixations = NULL;
tb->common.compress = is_compressed;
- cret = meth->db_create(BIF_P, tb);
+#ifdef DEBUG
+ cret =
+#endif
+ meth->db_create(BIF_P, tb);
ASSERT(cret == DB_ERROR_NONE);
erts_smp_spin_lock(&meta_main_tab_main_lock);
@@ -1941,8 +1967,10 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2)
/*
** This is for trapping, cannot be called directly.
*/
-static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1)
+static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2108,7 +2136,7 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2)
BIF_RETTYPE ets_match_1(BIF_ALIST_1)
{
- return ets_select_1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE ets_match_2(BIF_ALIST_2)
@@ -2124,7 +2152,7 @@ BIF_RETTYPE ets_match_2(BIF_ALIST_2)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_2(BIF_P, BIF_ARG_1, ms);
+ res = ets_select2(BIF_P, BIF_ARG_1, ms);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2142,7 +2170,7 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
+ res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2150,6 +2178,12 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3)
BIF_RETTYPE ets_select_3(BIF_ALIST_3)
{
+ return ets_select3(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2160,22 +2194,22 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3)
CHECK_TABLES();
/* Chunk size strictly greater than 0 */
- if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if (is_not_small(arg3) || (chunk_size = signed_val(arg3)) <= 0) {
+ BIF_ERROR(p, BADARG);
}
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- safety = ITERATION_SAFETY(BIF_P,tb);
+ safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(BIF_P, tb,
- BIF_ARG_2, chunk_size,
+ cret = tb->common.meth->db_select_chunk(p, tb,
+ arg2, chunk_size,
0 /* not reversed */,
&ret);
- if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
- fix_table_locked(BIF_P, tb);
+ if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ fix_table_locked(p, tb);
}
if (safety == ITER_UNSAFE) {
local_unfix_table(tb);
@@ -2187,22 +2221,24 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3)
ERTS_BIF_PREP_RET(result, ret);
break;
case DB_ERROR_SYSRES:
- ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT);
break;
default:
- ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
break;
}
- erts_match_set_release_result(BIF_P);
+ erts_match_set_release_result(p);
return result;
}
/* We get here instead of in the real BIF when trapping */
-static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1)
+static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2247,6 +2283,11 @@ static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1)
BIF_RETTYPE ets_select_1(BIF_ALIST_1)
{
+ return ets_select1(BIF_P, BIF_ARG_1);
+}
+
+static BIF_RETTYPE ets_select1(Process *p, Eterm arg1)
+{
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2260,28 +2301,27 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1)
* Make sure that the table exists.
*/
- if (!is_tuple(BIF_ARG_1)) {
- if (BIF_ARG_1 == am_EOT) {
+ if (!is_tuple(arg1)) {
+ if (arg1 == am_EOT) {
BIF_RET(am_EOT);
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- tptr = tuple_val(BIF_ARG_1);
+ tptr = tuple_val(arg1);
if (arityval(*tptr) < 1 ||
- (tb = db_get_table(BIF_P, tptr[1], DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ (tb = db_get_table(p, tptr[1], DB_READ, LCK_READ)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- safety = ITERATION_SAFETY(BIF_P,tb);
+ safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_continue(BIF_P,tb,
- BIF_ARG_1, &ret);
+ cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret);
- if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
- fix_table_locked(BIF_P, tb);
+ if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ fix_table_locked(p, tb);
}
if (safety == ITER_UNSAFE) {
local_unfix_table(tb);
@@ -2293,20 +2333,26 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1)
ERTS_BIF_PREP_RET(result, ret);
break;
case DB_ERROR_SYSRES:
- ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT);
break;
default:
- ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
break;
}
- erts_match_set_release_result(BIF_P);
+ erts_match_set_release_result(p);
return result;
}
BIF_RETTYPE ets_select_2(BIF_ALIST_2)
{
+ return ets_select2(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE
+ets_select2(Process* p, Eterm arg1, Eterm arg2)
+{
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2319,19 +2365,19 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2)
* Make sure that the table exists.
*/
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- safety = ITERATION_SAFETY(BIF_P,tb);
+ safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(BIF_P, tb, BIF_ARG_2,
+ cret = tb->common.meth->db_select(p, tb, arg2,
0, &ret);
- if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
- fix_table_locked(BIF_P, tb);
+ if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ fix_table_locked(p, tb);
}
if (safety == ITER_UNSAFE) {
local_unfix_table(tb);
@@ -2343,21 +2389,23 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2)
ERTS_BIF_PREP_RET(result, ret);
break;
case DB_ERROR_SYSRES:
- ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT);
break;
default:
- ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
break;
}
- erts_match_set_release_result(BIF_P);
+ erts_match_set_release_result(p);
return result;
}
/* We get here instead of in the real BIF when trapping */
-static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1)
+static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2498,7 +2546,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1)
{
- return ets_select_1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
@@ -2552,7 +2600,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
*/
BIF_RETTYPE ets_match_object_1(BIF_ALIST_1)
{
- return ets_select_1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE ets_match_object_2(BIF_ALIST_2)
@@ -2568,7 +2616,7 @@ BIF_RETTYPE ets_match_object_2(BIF_ALIST_2)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_2(BIF_P, BIF_ARG_1, ms);
+ res = ets_select2(BIF_P, BIF_ARG_1, ms);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2586,7 +2634,7 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
+ res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2605,7 +2653,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
int i;
Eterm* hp;
/*Process* rp = NULL;*/
+ /* If/when we implement lockless private tables:
Eterm owner;
+ */
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
@@ -2614,7 +2664,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+ /* If/when we implement lockless private tables:
owner = tb->common.owner;
+ */
/* If/when we implement lockless private tables:
if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) {
@@ -3520,8 +3572,10 @@ static void free_heir_data(DbTable* tb)
#endif
}
-static BIF_RETTYPE ets_delete_trap(Process *p, Eterm cont)
+static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm cont = BIF_ARG_1;
int trap;
Eterm* ptr = big_val(cont);
DbTable *tb = *((DbTable **) (UWord) (ptr + 1));
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index e3380a57b2..038a667b06 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -312,15 +312,24 @@ struct ext_segment {
struct segment* segtab[1]; /* The segment table */
};
#define SIZEOF_EXTSEG(NSEGS) \
- (sizeof(struct ext_segment) - sizeof(struct segment*) + sizeof(struct segment*)*(NSEGS))
+ (offsetof(struct ext_segment,segtab) + sizeof(struct segment*)*(NSEGS))
-#ifdef DEBUG
-# include <stddef.h> /* offsetof */
+#if defined(DEBUG) || defined(VALGRIND)
# define EXTSEG(SEGTAB_PTR) \
((struct ext_segment*) (((char*)(SEGTAB_PTR)) - offsetof(struct ext_segment,segtab)))
#endif
+static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb,
+ struct segment** segtab)
+{
+ erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) segtab);
+#ifdef VALGRIND
+ tb->top_ptr_to_segment_with_active_segtab = EXTSEG(segtab);
+#endif
+}
+
+
/* How the table segments relate to each other:
ext_segment: ext_segment: "plain" segment
@@ -649,7 +658,8 @@ int db_create_hash(Process *p, DbTable *tbl)
erts_smp_atomic_init_nob(&tb->szm, SEGSZ_MASK);
erts_smp_atomic_init_nob(&tb->nactive, SEGSZ);
erts_smp_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL);
- erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t) alloc_ext_seg(tb,0,NULL)->segtab);
+ erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL);
+ SET_SEGTAB(tb, alloc_ext_seg(tb,0,NULL)->segtab);
tb->nsegs = NSEG_1;
tb->nslots = SEGSZ;
@@ -2357,7 +2367,7 @@ static int alloc_seg(DbTableHash *tb)
struct ext_segment* eseg;
eseg = (struct ext_segment*) SEGTAB(tb)[seg_ix-1];
MY_ASSERT(eseg!=NULL && eseg->s.is_ext_segment);
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) eseg->segtab);
+ SET_SEGTAB(tb, eseg->segtab);
tb->nsegs = eseg->nsegs;
}
ASSERT(seg_ix < tb->nsegs);
@@ -2429,7 +2439,7 @@ static int free_seg(DbTableHash *tb, int free_records)
MY_ASSERT(newtop->s.is_ext_segment);
if (newtop->prev_segtab != NULL) {
/* Time to use a smaller segtab */
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t)newtop->prev_segtab);
+ SET_SEGTAB(tb, newtop->prev_segtab);
tb->nsegs = seg_ix;
ASSERT(tb->nsegs == EXTSEG(SEGTAB(tb))->nsegs);
}
@@ -2446,7 +2456,7 @@ static int free_seg(DbTableHash *tb, int free_records)
if (seg_ix > 0) {
if (seg_ix < tb->nsegs) SEGTAB(tb)[seg_ix] = NULL;
} else {
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t)NULL);
+ SET_SEGTAB(tb, NULL);
}
#endif
tb->nslots -= SEGSZ;
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index e0285fa5ed..23ac493118 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -58,6 +58,9 @@ typedef struct db_table_hash {
#ifdef ERTS_SMP
DbTableHashFineLocks* locks;
#endif
+#ifdef VALGRIND
+ struct ext_segment* top_ptr_to_segment_with_active_segtab;
+#endif
} DbTableHash;
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index c6f0d80e32..312050b931 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -344,8 +344,8 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b,
int *done);
static int do_partly_bound_can_match_greater(Eterm a, Eterm b,
int *done);
-static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1,
- Eterm a2, Eterm a3);
+static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3);
+
/* Method interface functions */
static int db_first_tree(Process *p, DbTable *tbl,
@@ -844,8 +844,12 @@ static int db_slot_tree(Process *p, DbTable *tbl,
-static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, Eterm a2, Eterm a3)
+static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
+ Eterm a2 = BIF_ARG_2;
+ Eterm a3 = BIF_ARG_3;
Eterm list;
Eterm result;
Eterm* hp;
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 68b7b7aa6a..4821a7d9fb 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -496,7 +496,7 @@ static erts_smp_atomic32_t trace_control_word;
/* This needs to be here, before the bif table... */
-static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val);
+static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1);
/*
** The table of callable bif's, i e guard bif's and
@@ -909,14 +909,18 @@ static void db_free_tmp_uncompressed(DbTerm* obj);
/*
** Pseudo BIF:s to be callable from the PAM VM.
*/
-
-BIF_RETTYPE db_get_trace_control_word_0(Process *p)
+BIF_RETTYPE db_get_trace_control_word(Process *p)
{
Uint32 tcw = (Uint32) erts_smp_atomic32_read_acqb(&trace_control_word);
BIF_RET(erts_make_integer((Uint) tcw, p));
}
-BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new)
+BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0)
+{
+ BIF_RET(db_get_trace_control_word(BIF_P));
+}
+
+BIF_RETTYPE db_set_trace_control_word(Process *p, Eterm new)
{
Uint val;
Uint32 old_tcw;
@@ -924,20 +928,27 @@ BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new)
BIF_ERROR(p, BADARG);
if (val != ((Uint32)val))
BIF_ERROR(p, BADARG);
-
+
old_tcw = (Uint32) erts_smp_atomic32_xchg_relb(&trace_control_word,
(erts_aint32_t) val);
BIF_RET(erts_make_integer((Uint) old_tcw, p));
}
-static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm new)
+BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1)
{
+ BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_1));
+}
+
+static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1)
+{
+ Process *p = BIF_P;
+ Eterm new = BIF_ARG_1;
Uint val;
if (!term_to_Uint(new, &val))
BIF_ERROR(p, BADARG);
if (val != ((Uint32)val))
BIF_ERROR(p, BADARG);
- BIF_RET(db_get_trace_control_word_0(p));
+ BIF_RET(db_get_trace_control_word(p));
}
/*
@@ -1705,6 +1716,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
Process *current_scheduled;
ErtsSchedulerData *esdp;
Eterm (*bif)(Process*, ...);
+ Eterm bif_args[3];
int fail_label;
int atomic_trace;
#if HALFWORD_HEAP
@@ -1958,7 +1970,7 @@ restart:
break;
case matchCall0:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc);
+ t = (*bif)(build_proc, bif_args);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1969,7 +1981,7 @@ restart:
break;
case matchCall1:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc, esp[-1]);
+ t = (*bif)(build_proc, esp-1);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1980,7 +1992,9 @@ restart:
break;
case matchCall2:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc, esp[-1], esp[-2]);
+ bif_args[0] = esp[-1];
+ bif_args[1] = esp[-2];
+ t = (*bif)(build_proc, bif_args);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1992,7 +2006,10 @@ restart:
break;
case matchCall3:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]);
+ bif_args[0] = esp[-1];
+ bif_args[1] = esp[-2];
+ bif_args[2] = esp[-3];
+ t = (*bif)(build_proc, bif_args);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -2847,7 +2864,9 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
Uint new_sz = offset + db_size_dbterm_comp(tb, obj);
byte* basep;
DbTerm* newp;
+#ifdef DEBUG
byte* top;
+#endif
ASSERT(tb->compress);
if (old != 0) {
@@ -2869,7 +2888,10 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
}
newp->size = size_object(obj);
- top = copy_to_comp(tb, obj, newp, new_sz);
+#ifdef DEBUG
+ top =
+#endif
+ copy_to_comp(tb, obj, newp, new_sz);
ASSERT(top <= basep + new_sz);
/* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */
@@ -4971,7 +4993,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 = seq_trace_info_1(p,arg1);
+ Eterm result = erl_seq_trace_info(p, arg1);
if (is_tuple(result) && *tuple_val(result) == 2) {
return (tuple_val(result))[2];
}
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index bb1751d309..6a96e174e1 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -326,8 +326,10 @@ ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b)
(T)->common.owner == (P)->id)
/* Function prototypes */
-Eterm db_get_trace_control_word_0(Process *p);
-Eterm db_set_trace_control_word_1(Process *p, Eterm val);
+BIF_RETTYPE db_get_trace_control_word(Process* p);
+BIF_RETTYPE db_set_trace_control_word(Process* p, Eterm tcw);
+BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0);
+BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1);
void db_initialize_util(void);
Eterm db_getkey(int keypos, Eterm obj);
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 8faaf9f367..eb2b945877 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -315,7 +315,12 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
if (is_non_value(result)) {
if (p->freason == TRAP) {
- cost = erts_garbage_collect(p, 0, p->def_arg_reg, p->arity);
+ #if HIPE
+ if (regs == NULL) {
+ regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array;
+ }
+ #endif
+ cost = erts_garbage_collect(p, 0, regs, p->arity);
} else {
cost = erts_garbage_collect(p, 0, regs, arity);
}
@@ -590,7 +595,9 @@ erts_garbage_collect_hibernate(Process* p)
void
-erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
+erts_garbage_collect_literals(Process* p, Eterm* literals,
+ Uint lit_size,
+ struct erl_off_heap_header* oh)
{
Uint byte_lit_size = sizeof(Eterm)*lit_size;
Uint old_heap_size;
@@ -602,6 +609,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
Uint area_size;
Eterm* old_htop;
Uint n;
+ struct erl_off_heap_header** prev;
/*
* Set GC state.
@@ -635,6 +643,9 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
offset_heap(temp_lit, lit_size, offs, (char *) literals, byte_lit_size);
offset_heap(p->heap, p->htop - p->heap, offs, (char *) literals, byte_lit_size);
offset_rootset(p, offs, (char *) literals, byte_lit_size, p->arg_reg, p->arity);
+ if (oh) {
+ oh = (struct erl_off_heap_header *) ((Eterm *)(void *) oh + offs);
+ }
/*
* Now the literals are placed in memory that is safe to write into,
@@ -702,6 +713,45 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
p->old_htop = old_htop;
/*
+ * Prepare to sweep binaries. Since all MSOs on the new heap
+ * must be come before MSOs on the old heap, find the end of
+ * current MSO list and use that as a starting point.
+ */
+
+ if (oh) {
+ prev = &MSO(p).first;
+ while (*prev) {
+ prev = &(*prev)->next;
+ }
+ }
+
+ /*
+ * Sweep through all binaries in the temporary literal area.
+ */
+
+ while (oh) {
+ if (IS_MOVED_BOXED(oh->thing_word)) {
+ Binary* bptr;
+ struct erl_off_heap_header* ptr;
+
+ ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
+ ASSERT(thing_subtag(ptr->thing_word) == REFC_BINARY_SUBTAG);
+ bptr = ((ProcBin*)ptr)->val;
+
+ /*
+ * This binary has been copied to the heap.
+ * We must increment its reference count and
+ * link it into the MSO list for the process.
+ */
+
+ erts_refc_inc(&bptr->refc, 1);
+ *prev = ptr;
+ prev = &ptr->next;
+ }
+ oh = oh->next;
+ }
+
+ /*
* We no longer need this temporary area.
*/
erts_free(ERTS_ALC_T_TMP, (void *) temp_lit);
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index fa4bab07b8..717315d8bd 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -92,7 +92,6 @@ int erts_use_sender_punish;
*/
Uint display_items; /* no of items to display in traces etc */
-Uint display_loads; /* print info about loaded modules */
int H_MIN_SIZE; /* The minimum heap grain */
int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/
@@ -129,6 +128,8 @@ int erts_modified_timing_level;
int erts_no_crash_dump = 0; /* Use -d to suppress crash dump. */
+int erts_no_line_info = 0; /* -L: Don't load line information */
+
/*
* Other global variables.
*/
@@ -433,7 +434,7 @@ static void
load_preloaded(void)
{
int i;
- int res;
+ Eterm res;
Preload* preload_p;
Eterm module_name;
byte* code;
@@ -452,8 +453,9 @@ load_preloaded(void)
name);
res = erts_load_module(NULL, 0, NIL, &module_name, code, length);
sys_preload_end(&preload_p[i]);
- if (res < 0)
- erl_exit(1,"Failed loading preloaded module %s\n", name);
+ if (res != NIL)
+ erl_exit(1,"Failed loading preloaded module %s (%T)\n",
+ name, res);
i++;
}
}
@@ -495,8 +497,6 @@ void erts_usage(void)
erts_fprintf(stderr, "-K boolean enable or disable kernel poll\n");
- erts_fprintf(stderr, "-l turn on auto load tracing\n");
-
erts_fprintf(stderr, "-M<X> <Y> memory allocator switches,\n");
erts_fprintf(stderr, " see the erts_alloc(3) documentation for more info.\n");
@@ -511,6 +511,8 @@ void erts_usage(void)
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, "-scl bool enable/disable compaction of scheduler load,\n");
+ erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
erts_fprintf(stderr, "-sct cput set cpu topology,\n");
erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
erts_fprintf(stderr, "-swt val set scheduler wakeup threshold, valid values are:\n");
@@ -608,10 +610,10 @@ early_init(int *argc, char **argv) /*
char envbuf[21]; /* enough for any 64-bit integer */
size_t envbufsz;
+ erts_sched_compact_load = 1;
erts_printf_eterm_func = erts_printf_term;
erts_disable_tolerant_timeofday = 0;
display_items = 200;
- display_loads = 0;
erts_backtrace_depth = DEFAULT_BACKTRACE_SIZE;
erts_async_max_threads = 0;
erts_async_thread_suggested_stack_size = ERTS_ASYNC_THREAD_MIN_STACK_SIZE;
@@ -976,10 +978,9 @@ erl_start(int argc, char **argv)
erts_fprintf(stderr, "%s unknown flag %s\n", argv[0], argv[i]);
erts_usage();
}
- case 'l':
- display_loads++;
+ case 'L':
+ erts_no_line_info = 1;
break;
-
case 'v':
#ifdef DEBUG
if (argv[i][2] == '\0') {
@@ -1197,6 +1198,19 @@ erl_start(int argc, char **argv)
erts_usage();
}
}
+ else if (has_prefix("cl", sub_param)) {
+ arg = get_arg(sub_param+2, argv[i+1], &i);
+ if (sys_strcmp("true", arg) == 0)
+ erts_sched_compact_load = 1;
+ else if (sys_strcmp("false", arg) == 0)
+ erts_sched_compact_load = 0;
+ else {
+ erts_fprintf(stderr,
+ "bad scheduler compact load value '%s'\n",
+ arg);
+ erts_usage();
+ }
+ }
else if (has_prefix("ct", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
res = erts_init_cpu_topology_string(arg);
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 82f272d28a..16be47d540 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -240,7 +240,7 @@ erts_msg_distext2heap(Process *pp,
Sint sz;
*bpp = NULL;
- sz = erts_decode_dist_ext_size(dist_extp, 0);
+ sz = erts_decode_dist_ext_size(dist_extp);
if (sz < 0)
goto decode_error;
if (is_not_nil(*tokenp)) {
@@ -713,7 +713,7 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
ASSERT(msg->data.dist_ext);
ASSERT(msg->data.dist_ext->heap_size < 0);
- sz = erts_decode_dist_ext_size(msg->data.dist_ext, 0);
+ sz = erts_decode_dist_ext_size(msg->data.dist_ext);
if (sz < 0) {
/* Bad external; remove it */
if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index 47597f302b..1a84950120 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -948,8 +948,10 @@ static void erts_dump_links(ErtsLink *root, int indent)
erts_destroy_tmp_dsbuf(dsbufp);
}
-Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid)
+Eterm erts_debug_dump_monitors_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm pid = BIF_ARG_1;
Process *rp;
DistEntry *dep;
rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK);
@@ -976,8 +978,10 @@ Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid)
}
}
-Eterm erts_debug_dump_links_1(Process *p, Eterm pid)
+Eterm erts_debug_dump_links_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm pid = BIF_ARG_1;
Process *rp;
DistEntry *dep;
if (is_internal_port(pid)) {
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 818156fce6..740a1b853e 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -131,10 +131,13 @@ static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif)
env->tmp_obj_list = NULL;
}
-/* Temporary object header, auto-deallocated when NIF returns. */
+/* Temporary object header, auto-deallocated when NIF returns
+ * or when independent environment is cleared.
+ */
struct enif_tmp_obj_t {
struct enif_tmp_obj_t* next;
void (*dtor)(struct enif_tmp_obj_t*);
+ ErtsAlcType_t allocator;
/*char data[];*/
};
@@ -245,7 +248,7 @@ ErlNifEnv* enif_alloc_env(void)
msg_env->env.hp_end = phony_heap;
msg_env->env.heap_frag = NULL;
msg_env->env.mod_nif = NULL;
- msg_env->env.tmp_obj_list = (struct enif_tmp_obj_t*) 1; /* invalid non-NULL */
+ msg_env->env.tmp_obj_list = NULL;
msg_env->env.proc = &msg_env->phony_proc;
memset(&msg_env->phony_proc, 0, sizeof(Process));
HEAP_START(&msg_env->phony_proc) = phony_heap;
@@ -290,6 +293,7 @@ void enif_clear_env(ErlNifEnv* env)
menv->env.hp = menv->env.hp_end = HEAP_TOP(p);
ASSERT(!is_offheap(&MSO(p)));
+ free_tmp_objs(env);
}
int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErlNifEnv* msg_env, ERL_NIF_TERM msg)
@@ -436,24 +440,36 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)
return term == THE_NON_VALUE;
}
+int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return is_number(term);
+}
+
+static ERTS_INLINE int is_proc_bound(ErlNifEnv* env)
+{
+ return env->mod_nif != NULL;
+}
+
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
- erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP);
+ erts_free_aligned_binary_bytes_extra((byte*)obj, obj->allocator);
}
int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
{
+ ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
union {
struct enif_tmp_obj_t* tmp;
byte* raw_ptr;
}u;
u.tmp = NULL;
- bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, ERTS_ALC_T_TMP,
+ bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator,
sizeof(struct enif_tmp_obj_t));
if (bin->data == NULL) {
return 0;
}
if (u.tmp != NULL) {
+ u.tmp->allocator = allocator;
u.tmp->next = env->tmp_obj_list;
u.tmp->dtor = &aligned_binary_dtor;
env->tmp_obj_list = u.tmp;
@@ -467,12 +483,13 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
static void tmp_alloc_dtor(struct enif_tmp_obj_t* obj)
{
- erts_free(ERTS_ALC_T_TMP, obj);
+ erts_free(obj->allocator, obj);
}
int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
{
struct enif_tmp_obj_t* tobj;
+ ErtsAlcType_t allocator;
Uint sz;
if (is_binary(term)) {
return enif_inspect_binary(env,term,bin);
@@ -487,8 +504,10 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
if (erts_iolist_size(term, &sz)) {
return 0;
}
-
- tobj = erts_alloc(ERTS_ALC_T_TMP, sz + sizeof(struct enif_tmp_obj_t));
+
+ allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
+ tobj = erts_alloc(allocator, sz + sizeof(struct enif_tmp_obj_t));
+ tobj->allocator = allocator;
tobj->next = env->tmp_obj_list;
tobj->dtor = &tmp_alloc_dtor;
env->tmp_obj_list = tobj;
@@ -677,6 +696,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
ErlSubBin* sb;
Eterm orig;
Uint offset, bit_offset, bit_size;
+#ifdef DEBUG
unsigned src_size;
ASSERT(is_binary(bin_term));
@@ -684,6 +704,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
ASSERT(pos <= src_size);
ASSERT(size <= src_size);
ASSERT(pos + size <= src_size);
+#endif
sb = (ErlSubBin*) alloc_heap(env, ERL_SUB_BIN_SIZE);
ERTS_GET_REAL_BIN(bin_term, orig, offset, bit_offset, bit_size);
sb->thing_word = HEADER_SUB_BIN;
@@ -1022,6 +1043,29 @@ void enif_system_info(ErlNifSysInfo *sip, size_t si_size)
driver_system_info(sip, si_size);
}
+int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) {
+ Eterm *listptr, ret = NIL, *hp;
+
+ if (is_nil(term)) {
+ *list = term;
+ return 1;
+ }
+
+ ret = NIL;
+
+ while (is_not_nil(term)) {
+ if (is_not_list(term)) {
+ return 0;
+ }
+ hp = alloc_heap(env, 2);
+ listptr = list_val(term);
+ ret = CONS(hp, CAR(listptr), ret);
+ term = CDR(listptr);
+ }
+ *list = ret;
+ return 1;
+}
+
ErlNifMutex* enif_mutex_create(char *name) { return erl_drv_mutex_create(name); }
void enif_mutex_destroy(ErlNifMutex *mtx) { erl_drv_mutex_destroy(mtx); }
@@ -1625,7 +1669,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
}
else { /* Function traced, patch the original instruction word */
BpData** bps = (BpData**) code_ptr[1];
- BpData* bp = (BpData*) bps[bp_sched2ix()];
+ BpData* bp = (BpData*) bps[erts_bp_sched2ix()];
bp->orig_instr = (BeamInstr) BeamOp(op_call_nif);
}
code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr;
@@ -1716,8 +1760,10 @@ struct readonly_check_t
};
static void add_readonly_check(ErlNifEnv* env, unsigned char* ptr, unsigned sz)
{
- struct readonly_check_t* obj = erts_alloc(ERTS_ALC_T_TMP,
+ ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
+ struct readonly_check_t* obj = erts_alloc(allocator,
sizeof(struct readonly_check_t));
+ obj->hdr.allocator = allocator;
obj->hdr.next = env->tmp_obj_list;
env->tmp_obj_list = &obj->hdr;
obj->hdr.dtor = &readonly_check_dtor;
@@ -1734,7 +1780,7 @@ static void readonly_check_dtor(struct enif_tmp_obj_t* o)
" %x != %x\r\nABORTING\r\n", chksum, obj->checksum);
abort();
}
- erts_free(ERTS_ALC_T_TMP, obj);
+ erts_free(obj->hdr.allocator, obj);
}
static unsigned calc_checksum(unsigned char* ptr, unsigned size)
{
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index d028567faf..fea527f954 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -32,9 +32,10 @@
** 2.0: R14A
** 2.1: R14B02 "vm_variant"
** 2.2: R14B03 enif_is_exception
+** 2.3: R15 enif_make_reverse_list
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 2
+#define ERL_NIF_MINOR_VERSION 3
#include <stdlib.h>
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index c991b61abe..6396af09d0 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -136,6 +136,8 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
#endif
ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list));
+ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term));
/*
** Add new entries here to keep compatibility on Windows!!!
@@ -256,12 +258,207 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
#endif
# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
+# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list)
+# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number)
/*
** Add new entries here
*/
#endif
+
+#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+
+/* Inline functions for compile time type checking of arguments to
+ variadic functions.
+*/
+
+# define ERL_NIF_INLINE __inline__
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env,
+ ERL_NIF_TERM e1)
+{
+ return enif_make_tuple(env, 1, e1);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2)
+{
+ return enif_make_tuple(env, 2, e1, e2);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3)
+{
+ return enif_make_tuple(env, 3, e1, e2, e3);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4)
+{
+ return enif_make_tuple(env, 4, e1, e2, e3, e4);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5)
+{
+ return enif_make_tuple(env, 5, e1, e2, e3, e4, e5);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6)
+{
+ return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7)
+{
+ return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8)
+{
+ return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8,
+ ERL_NIF_TERM e9)
+{
+ return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env,
+ ERL_NIF_TERM e1)
+{
+ return enif_make_list(env, 1, e1);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2)
+{
+ return enif_make_list(env, 2, e1, e2);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3)
+{
+ return enif_make_list(env, 3, e1, e2, e3);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4)
+{
+ return enif_make_list(env, 4, e1, e2, e3, e4);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5)
+{
+ return enif_make_list(env, 5, e1, e2, e3, e4, e5);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6)
+{
+ return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7)
+{
+ return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8)
+{
+ return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8,
+ ERL_NIF_TERM e9)
+{
+ return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9);
+}
+
+# undef ERL_NIF_INLINE
+
+#else /* fallback with macros */
+
#ifndef enif_make_list1
# define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1)
# define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2)
@@ -281,6 +478,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
# define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7)
# define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8)
# define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9)
+#endif
+
+#endif /* __GNUC__ && !WIN32 */
+
+#ifndef enif_make_pid
# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid))
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 04926fe283..ec4b1dcd98 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -114,6 +114,7 @@ static Sint p_serial;
static Uint p_serial_mask;
static Uint p_serial_shift;
+int erts_sched_compact_load;
Uint erts_no_schedulers;
Uint erts_max_processes = ERTS_DEFAULT_MAX_PROCESSES;
Uint erts_process_tab_index_mask;
@@ -222,10 +223,6 @@ typedef union {
static ErtsAlignedSchedulerSleepInfo *aligned_sched_sleep_info;
-#ifndef BM_COUNTERS
-static int processes_busy;
-#endif
-
Process** process_tab;
static Uint last_reductions;
static Uint last_exact_reductions;
@@ -494,9 +491,6 @@ erts_init_process(int ncpu)
p_serial_shift = erts_fit_in_bits(erts_max_processes - 1);
p_serial_mask = ((~(~((Uint) 0) << proc_bits)) >> p_serial_shift);
erts_process_tab_index_mask = ~(~((Uint) 0) << p_serial_shift);
-#ifndef BM_COUNTERS
- processes_busy = 0;
-#endif
last_reductions = 0;
last_exact_reductions = 0;
erts_default_process_flags = 0;
@@ -2885,6 +2879,9 @@ check_balance(ErtsRunQueue *c_rq)
mmax_len = run_queue_info[qix].max_len;
}
+ if (!erts_sched_compact_load)
+ goto all_active;
+
if (!forced && half_full_scheds != blnc_no_rqs) {
int min = 1;
if (min < half_full_scheds)
@@ -3407,11 +3404,14 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online)
erts_bits_init_state(&esdp->erl_bits_state);
esdp->match_pseudo_process = NULL;
esdp->free_process = NULL;
-#if HALFWORD_HEAP
- /* Registers need to be heap allocated (correct memory range) for tracing to work */
- esdp->save_reg = erts_alloc(ERTS_ALC_T_BEAM_REGISTER, ERTS_X_REGS_ALLOCATED * sizeof(Eterm));
-#endif
#endif
+ esdp->x_reg_array =
+ erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
+ ERTS_X_REGS_ALLOCATED *
+ sizeof(Eterm));
+ esdp->f_reg_array =
+ erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
+ MAX_REG * sizeof(FloatDef));
#if !HEAP_ON_C_STACK
esdp->num_tmp_heap_used = 0;
#endif
@@ -6741,7 +6741,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
goto error;
}
+#ifdef BM_COUNTERS
processes_busy++;
+#endif
BM_COUNT(processes_spawned);
#ifndef HYBRID
@@ -6989,7 +6991,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->pending_exit.bp = NULL;
#endif
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
p->fp_exception = 0;
#endif
@@ -7163,7 +7165,7 @@ void erts_init_empty_process(Process *p)
p->run_queue = ERTS_RUNQ_IX(0);
#endif
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
p->fp_exception = 0;
#endif
@@ -8264,7 +8266,9 @@ continue_exit_process(Process *p
pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL);
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+#ifdef BM_COUNTERS
processes_busy--;
+#endif
if (dep) {
erts_do_net_exits(dep, reason);
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 67c0b72130..a51b380bb0 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -95,6 +95,7 @@ struct saved_calls {
};
extern Export exp_send, exp_receive, exp_timeout;
+extern int erts_sched_compact_load;
extern Uint erts_no_schedulers;
extern Uint erts_no_run_queues;
extern int erts_sched_thread_suggested_stack_size;
@@ -421,19 +422,15 @@ typedef struct {
} ErtsAuxWorkData;
struct ErtsSchedulerData_ {
-
-#ifdef ERTS_SMP
/*
* Keep X registers first (so we get as many low
* numbered registers as possible in the same cache
* line).
*/
-#if !HALFWORD_HEAP
- Eterm save_reg[ERTS_X_REGS_ALLOCATED]; /* X registers */
-#else
- Eterm *save_reg;
-#endif
- FloatDef freg[MAX_REG]; /* Floating point registers. */
+ Eterm* x_reg_array; /* X registers */
+ FloatDef* f_reg_array; /* Floating point registers. */
+
+#ifdef ERTS_SMP
ethr_tid tid; /* Thread id */
struct erl_bits_state erl_bits_state; /* erl_bits.c state */
void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */
@@ -604,7 +601,7 @@ struct process {
Uint min_heap_size; /* Minimum size of heap (in words). */
Uint min_vheap_size; /* Minimum size of virtual heap (in words). */
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
volatile unsigned long fp_exception;
#endif
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index da97523dd0..a5a753b798 100644
--- a/erts/emulator/beam/erl_process_lock.c
+++ b/erts/emulator/beam/erl_process_lock.c
@@ -669,7 +669,9 @@ proc_safelock(Process *a_proc,
ErtsProcLocks b_need_locks)
{
Process *p1, *p2;
+#ifdef ERTS_ENABLE_LOCK_CHECK
Eterm pid1, pid2;
+#endif
erts_pix_lock_t *pix_lck1, *pix_lck2;
ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2;
ErtsProcLocks unlock_mask;
@@ -684,24 +686,32 @@ proc_safelock(Process *a_proc,
if (a_proc) {
if (a_proc->id < b_proc->id) {
p1 = a_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = a_proc->id;
+#endif
pix_lck1 = a_pix_lck;
need_locks1 = a_need_locks;
have_locks1 = a_have_locks;
p2 = b_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = b_proc->id;
+#endif
pix_lck2 = b_pix_lck;
need_locks2 = b_need_locks;
have_locks2 = b_have_locks;
}
else if (a_proc->id > b_proc->id) {
p1 = b_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = b_proc->id;
+#endif
pix_lck1 = b_pix_lck;
need_locks1 = b_need_locks;
have_locks1 = b_have_locks;
p2 = a_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = a_proc->id;
+#endif
pix_lck2 = a_pix_lck;
need_locks2 = a_need_locks;
have_locks2 = a_have_locks;
@@ -710,12 +720,16 @@ proc_safelock(Process *a_proc,
ERTS_LC_ASSERT(a_proc == b_proc);
ERTS_LC_ASSERT(a_proc->id == b_proc->id);
p1 = a_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = a_proc->id;
+#endif
pix_lck1 = a_pix_lck;
need_locks1 = a_need_locks | b_need_locks;
have_locks1 = a_have_locks | b_have_locks;
p2 = NULL;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = 0;
+#endif
pix_lck2 = NULL;
need_locks2 = 0;
have_locks2 = 0;
@@ -723,12 +737,16 @@ proc_safelock(Process *a_proc,
}
else {
p1 = b_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = b_proc->id;
+#endif
pix_lck1 = b_pix_lck;
need_locks1 = b_need_locks;
have_locks1 = b_have_locks;
p2 = NULL;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = 0;
+#endif
pix_lck2 = NULL;
need_locks2 = 0;
have_locks2 = 0;
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 1d75fa313c..bc20b2d798 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -331,7 +331,13 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
* we now use a non-zero bit-pattern in debug mode.
*/
#if ET_DEBUG
-#define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT)
+# ifdef HIPE
+ /* A very large (or negative) value as work-around for ugly hipe-bifs
+ that return untagged integers (eg hipe_bs_put_utf8) */
+# define THE_NON_VALUE _make_header((Uint)~0,_TAG_HEADER_FLOAT)
+# else
+# define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT)
+# endif
#else
#define THE_NON_VALUE (0)
#endif
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index ec99f76e53..b487dbf054 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2094,8 +2094,7 @@ void save_calls(Process *p, Export *e)
* entries instead of the original BIF functions.
*/
Eterm
-erts_bif_trace(int bif_index, Process* p,
- Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I)
+erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
{
Eterm result;
int meta = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_META);
@@ -2109,10 +2108,10 @@ erts_bif_trace(int bif_index, Process* p,
* no tracing will occur. Doing the whole else branch will
* also do nothing, only slower.
*/
- Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = bif_table[bif_index].f;
- result = func(p, arg1, arg2, arg3, I);
+ Eterm (*func)(Process*, Eterm*, BeamInstr*) = bif_table[bif_index].f;
+ result = func(p, args, I);
} else {
- Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*);
+ Eterm (*func)(Process*, Eterm*, BeamInstr*);
Export* ep = bif_export[bif_index];
Uint32 flags = 0, flags_meta = 0;
int global = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_GLOBAL);
@@ -2124,8 +2123,6 @@ erts_bif_trace(int bif_index, Process* p,
* export entry */
BeamInstr *cp = p->cp;
- Eterm args[3] = {arg1, arg2, arg3};
-
/*
* Make continuation pointer OK, it is not during direct BIF calls,
* but it is correct during apply of bif.
@@ -2157,7 +2154,7 @@ erts_bif_trace(int bif_index, Process* p,
func = bif_table[bif_index].f;
- result = func(p, arg1, arg2, arg3, I);
+ result = func(p, args, I);
if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) {
BeamInstr i_return_trace = beam_return_trace[0];
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 158eb361a4..6d5eae73b0 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -47,7 +47,7 @@ typedef struct _restart_context {
static Uint max_loop_limit;
-static BIF_RETTYPE utf8_to_list(BIF_ALIST_1);
+static BIF_RETTYPE utf8_to_list(Process *p, Eterm arg1);
static BIF_RETTYPE finalize_list_to_list(Process *p,
byte *bytes,
Eterm rest,
@@ -227,8 +227,8 @@ static ERTS_INLINE int simple_loops_to_common(int cost)
static Sint aligned_binary_size(Eterm binary)
{
- unsigned char *bytes;
- Uint bitoffs;
+ ERTS_DECLARE_DUMMY(unsigned char *bytes);
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
Uint bitsize;
ERTS_GET_BINARY_BYTES(binary, bytes, bitoffs, bitsize);
@@ -348,12 +348,6 @@ static int copy_utf8_bin(byte *target, byte *source, Uint size,
return copied;
}
- if (((*source) == 0xEF) && (source[1] == 0xBF) &&
- ((source[2] == 0xBE) || (source[2] == 0xBF))) {
- *err_pos = source;
- return copied;
- }
-
*(target++) = *(source++);
*(target++) = *(source++);
*(target++) = *(source++);
@@ -714,9 +708,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
target[(*pos)++] = (((byte) (x & 0x3F)) |
((byte) 0x80));
} else if (x < 0x10000) {
- if ((x >= 0xD800 && x <= 0xDFFF) ||
- (x == 0xFFFE) ||
- (x == 0xFFFF)) { /* Invalid unicode range */
+ if (x >= 0xD800 && x <= 0xDFFF) {
+ /* Invalid unicode range */
*err = 1;
goto done;
}
@@ -901,7 +894,9 @@ static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos,
static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
{
+#ifdef DEBUG
Eterm *real_bin;
+#endif
byte* bytes;
Eterm rest_term;
int left, sleft;
@@ -915,8 +910,10 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
/*erts_printf("Trap %T!\r\n",BIF_ARG_2);*/
ASSERT(is_binary(BIF_ARG_1));
+#ifdef DEBUG
real_bin = binary_val(BIF_ARG_1);
ASSERT(*real_bin == HEADER_PROC_BIN);
+#endif
pos = (int) binary_size(BIF_ARG_1);
bytes = binary_bytes(BIF_ARG_1);
sleft = left = allowed_iterations(BIF_P);
@@ -1230,10 +1227,6 @@ int erts_analyze_utf8(byte *source, Uint size,
((source[1] & 0x20) != 0)) {
return ERTS_UTF8_ERROR;
}
- if (((*source) == 0xEF) && (source[1] == 0xBF) &&
- ((source[2] == 0xBE) || (source[2] == 0xBF))) {
- return ERTS_UTF8_ERROR;
- }
source += 3;
size -= 3;
} else if (((*source) & ((byte) 0xF8)) == 0xF0) {
@@ -1730,7 +1723,7 @@ static BIF_RETTYPE do_bif_utf8_to_list(Process *p,
if (b_sz) {
ErlSubBin *sb;
Eterm orig;
- Uint offset;
+ ERTS_DECLARE_DUMMY(Uint offset);
ASSERT(state != ERTS_UTF8_OK);
hp = HAlloc(p, ERL_SUB_BIN_SIZE);
sb = (ErlSubBin *) hp;
@@ -1839,13 +1832,13 @@ static BIF_RETTYPE characters_to_list_trap_4(BIF_ALIST_1)
* Instead of building an utf8 buffer, we analyze the binary given and use that.
*/
-static BIF_RETTYPE utf8_to_list(BIF_ALIST_1)
+static BIF_RETTYPE utf8_to_list(Process* p, Eterm arg)
{
- if (!is_binary(BIF_ARG_1) || aligned_binary_size(BIF_ARG_1) < 0) {
- BIF_ERROR(BIF_P,BADARG);
+ if (!is_binary(arg) || aligned_binary_size(arg) < 0) {
+ BIF_ERROR(p, BADARG);
}
- return do_bif_utf8_to_list(BIF_P, BIF_ARG_1, 0U, 0U, 0U,
- ERTS_UTF8_ANALYZE_MORE,NIL);
+ return do_bif_utf8_to_list(p, arg, 0U, 0U, 0U,
+ ERTS_UTF8_ANALYZE_MORE, NIL);
}
@@ -2166,9 +2159,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
} else if (x < 0x800) {
need += 2;
} else if (x < 0x10000) {
- if ((x >= 0xD800 && x <= 0xDFFF) ||
- (x == 0xFFFE) ||
- (x == 0xFFFF)) { /* Invalid unicode range */
+ if (x >= 0xD800 && x <= 0xDFFF) {
+ /* Invalid unicode range */
DESTROY_ESTACK(stack);
return ((Sint) -1);
}
@@ -2314,9 +2306,7 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
*p++ = (((byte) (x & 0x3F)) |
((byte) 0x80));
} else if (x < 0x10000) {
- ASSERT(!((x >= 0xD800 && x <= 0xDFFF) ||
- (x == 0xFFFE) ||
- (x == 0xFFFF)));
+ ASSERT(!(x >= 0xD800 && x <= 0xDFFF));
*p++ = (((byte) (x >> 12)) |
((byte) 0xE0));
*p++ = ((((byte) (x >> 6)) & 0x3F) |
@@ -2580,11 +2570,11 @@ BIF_RETTYPE prim_file_internal_native2name_1(BIF_ALIST_1)
BIF_RETTYPE prim_file_internal_normalize_utf8_1(BIF_ALIST_1)
{
- Eterm real_bin;
- Uint offset;
+ ERTS_DECLARE_DUMMY(Eterm real_bin);
+ ERTS_DECLARE_DUMMY(Uint offset);
Uint size,num_chars;
Uint bitsize;
- Uint bitoffs;
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
Eterm ret;
byte *temp_alloc = NULL;
byte *bytes;
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 0b07e894cf..5dc307e383 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -55,7 +55,7 @@
heap data on the C stack or if we use the buffers in the scheduler data. */
#define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers
small heap for transient heap data */
-#define CMP_TMP_HEAP_SIZE 2 /* cmp wants its own tmp-heap... */
+#define CMP_TMP_HEAP_SIZE 32 /* cmp wants its own tmp-heap... */
#define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */
#define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 6953e7fe7d..4b867f2b10 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -88,7 +88,7 @@ static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*);
static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*);
static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*);
-static Sint decoded_size(byte *ep, byte* endp, int only_heap_bins, int internal_tags);
+static Sint decoded_size(byte *ep, byte* endp, int internal_tags);
static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned);
@@ -810,7 +810,7 @@ bad_dist_ext(ErtsDistExternal *edep)
}
Sint
-erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins)
+erts_decode_dist_ext_size(ErtsDistExternal *edep)
{
Sint res;
byte *ep;
@@ -829,7 +829,7 @@ erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins)
goto fail;
ep = edep->extp+1;
}
- res = decoded_size(ep, edep->ext_endp, no_refc_bins, 0);
+ res = decoded_size(ep, edep->ext_endp, 0);
if (res >= 0)
return res;
fail:
@@ -837,16 +837,16 @@ erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins)
return -1;
}
-Sint erts_decode_ext_size(byte *ext, Uint size, int no_refc_bins)
+Sint erts_decode_ext_size(byte *ext, Uint size)
{
if (size == 0 || *ext != VERSION_MAGIC)
return -1;
- return decoded_size(ext+1, ext+size, no_refc_bins, 0);
+ return decoded_size(ext+1, ext+size, 0);
}
Sint erts_decode_ext_size_ets(byte *ext, Uint size)
{
- Sint sz = decoded_size(ext, ext+size, 0, 1);
+ Sint sz = decoded_size(ext, ext+size, 1);
ASSERT(sz >= 0);
return sz;
}
@@ -968,7 +968,7 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
ede.extp = binary_bytes(real_bin)+offset;
ede.ext_endp = ede.extp + size;
- hsz = erts_decode_dist_ext_size(&ede, 0);
+ hsz = erts_decode_dist_ext_size(&ede);
if (hsz < 0)
goto badarg;
@@ -988,16 +988,16 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
}
-Eterm
-term_to_binary_1(Process* p, Eterm Term)
+BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
{
- return erts_term_to_binary(p, Term, 0, TERM_TO_BINARY_DFLAGS);
+ return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS);
}
-
-Eterm
-term_to_binary_2(Process* p, Eterm Term, Eterm Flags)
+BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm Term = BIF_ARG_1;
+ Eterm Flags = BIF_ARG_2;
int level = 0;
Uint flags = TERM_TO_BINARY_DFLAGS;
@@ -1106,7 +1106,7 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size)
goto error;
size = (Sint) dest_len;
}
- res = decoded_size(state->extp, state->extp + size, 0, 0);
+ res = decoded_size(state->extp, state->extp + size, 0);
if (res < 0)
goto error;
return res;
@@ -1256,8 +1256,11 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
}
Eterm
-external_size_1(Process* p, Eterm Term)
+external_size_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm Term = BIF_ARG_1;
+
Uint size = erts_encode_ext_size(Term);
if (IS_USMALL(0, size)) {
BIF_RET(make_small(size));
@@ -1268,13 +1271,13 @@ external_size_1(Process* p, Eterm Term)
}
Eterm
-external_size_2(Process* p, Eterm Term, Eterm Flags)
+external_size_2(BIF_ALIST_2)
{
Uint size;
Uint flags = TERM_TO_BINARY_DFLAGS;
- while (is_list(Flags)) {
- Eterm arg = CAR(list_val(Flags));
+ while (is_list(BIF_ARG_2)) {
+ Eterm arg = CAR(list_val(BIF_ARG_2));
Eterm* tp;
if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) {
@@ -1293,19 +1296,19 @@ external_size_2(Process* p, Eterm Term, Eterm Flags)
}
} else {
error:
- BIF_ERROR(p, BADARG);
+ BIF_ERROR(BIF_P, BADARG);
}
- Flags = CDR(list_val(Flags));
+ BIF_ARG_2 = CDR(list_val(BIF_ARG_2));
}
- if (is_not_nil(Flags)) {
+ if (is_not_nil(BIF_ARG_2)) {
goto error;
}
- size = erts_encode_ext_size_2(Term, flags);
+ size = erts_encode_ext_size_2(BIF_ARG_1, flags);
if (IS_USMALL(0, size)) {
BIF_RET(make_small(size));
} else {
- Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE);
+ Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
BIF_RET(uint_to_big(size, hp));
}
}
@@ -2451,7 +2454,7 @@ dec_term_atom_common:
n = get_int32(ep);
ep += 4;
- if (n <= ERL_ONHEAP_BIN_LIMIT || off_heap == NULL) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
ErlHeapBin* hb = (ErlHeapBin *) hp;
hb->thing_word = header_heap_bin(n);
@@ -2489,7 +2492,7 @@ dec_term_atom_common:
n = get_int32(ep);
bitsize = ep[4];
ep += 5;
- if (n <= ERL_ONHEAP_BIN_LIMIT || off_heap == NULL) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
ErlHeapBin* hb = (ErlHeapBin *) hp;
hb->thing_word = header_heap_bin(n);
@@ -3058,7 +3061,7 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
}
static Sint
-decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags)
+decoded_size(byte *ep, byte* endp, int internal_tags)
{
int heap_size = 0;
int terms;
@@ -3220,7 +3223,7 @@ decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags)
CHKSIZE(4);
n = get_int32(ep);
SKIP2(n, 4);
- if (n <= ERL_ONHEAP_BIN_LIMIT || no_refc_bins) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
heap_size += heap_bin_size(n);
} else {
heap_size += PROC_BIN_SIZE;
@@ -3231,7 +3234,7 @@ decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags)
CHKSIZE(5);
n = get_int32(ep);
SKIP2(n, 5);
- if (n <= ERL_ONHEAP_BIN_LIMIT || no_refc_bins) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
heap_size += heap_bin_size(n) + ERL_SUB_BIN_SIZE;
} else {
heap_size += PROC_BIN_SIZE + ERL_SUB_BIN_SIZE;
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index 671b8b8781..eddd4571dd 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -175,10 +175,10 @@ void *erts_dist_ext_trailer(ErtsDistExternal *);
void erts_destroy_dist_ext_copy(ErtsDistExternal *);
int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint,
DistEntry *, ErtsAtomCache *);
-Sint erts_decode_dist_ext_size(ErtsDistExternal *, int);
+Sint erts_decode_dist_ext_size(ErtsDistExternal *);
Eterm erts_decode_dist_ext(Eterm **, ErlOffHeap *, ErtsDistExternal *);
-Sint erts_decode_ext_size(byte*, Uint, int);
+Sint erts_decode_ext_size(byte*, Uint);
Sint erts_decode_ext_size_ets(byte*, Uint);
Eterm erts_decode_ext(Eterm **, ErlOffHeap *, byte**);
Eterm erts_decode_ext_ets(Eterm **, ErlOffHeap *, byte*);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index b40bab9b33..d5b74efd98 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -37,6 +37,7 @@
#include "erl_process.h"
#include "erl_sys_driver.h"
#include "erl_debug.h"
+#include "error.h"
typedef struct port Port;
#include "erl_port_task.h"
@@ -554,7 +555,6 @@ extern Eterm node_cookie;
extern erts_smp_atomic_t erts_bytes_out; /* no bytes written out */
extern erts_smp_atomic_t erts_bytes_in; /* no bytes sent into the system */
extern Uint display_items; /* no of items to display in traces etc */
-extern Uint display_loads; /* print info about loaded modules */
extern int erts_backtrace_depth;
extern erts_smp_atomic32_t erts_max_gen_gcs;
@@ -845,18 +845,41 @@ void erts_queue_monitor_message(Process *,
Eterm,
Eterm);
void erts_init_bif(void);
+Eterm erl_send(Process *p, Eterm to, Eterm msg);
+
+/* erl_bif_op.c */
+
+Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
/* erl_bif_port.c */
/* erl_bif_trace.c */
+Eterm erl_seq_trace_info(Process *p, Eterm arg1);
void erts_system_monitor_clear(Process *c_p);
void erts_system_profile_clear(Process *c_p);
/* beam_load.c */
-int erts_load_module(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm* mod, byte* code, int size);
+typedef struct {
+ BeamInstr* current; /* Pointer to: Mod, Name, Arity */
+ Uint needed; /* Heap space needed for entire tuple */
+ Uint32 loc; /* Location in source code */
+ Eterm* fname_ptr; /* Pointer to fname table */
+} FunctionInfo;
+
+struct LoaderState* erts_alloc_loader_state(void);
+Eterm erts_prepare_loading(struct LoaderState*, Process *c_p,
+ Eterm group_leader, Eterm* modp,
+ byte* code, Uint size);
+Eterm erts_finish_loading(struct LoaderState* stp, Process* c_p,
+ ErtsProcLocks c_p_locks, Eterm* modp);
+Eterm erts_load_module(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm group_leader, Eterm* mod, byte* code, Uint size);
void init_load(void);
BeamInstr* find_function_from_pc(BeamInstr* pc);
+Eterm* erts_build_mfa_item(FunctionInfo* fi, Eterm* hp,
+ Eterm args, Eterm* mfa_p);
+void erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info);
+void erts_set_current_function(FunctionInfo* fi, BeamInstr* current);
Eterm erts_module_info_0(Process* p, Eterm module);
Eterm erts_module_info_1(Process* p, Eterm module, Eterm what);
Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info);
@@ -1047,6 +1070,7 @@ void init_emulator(void);
void process_main(void);
Eterm build_stacktrace(Process* c_p, Eterm exc);
Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value);
+void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth);
/* erl_init.c */
@@ -1068,6 +1092,7 @@ extern ErtsModifiedTimings erts_modified_timings[];
#define ERTS_MODIFIED_TIMING_INPUT_REDS \
(erts_modified_timings[erts_modified_timing_level].input_reds)
+extern int erts_no_line_info;
extern Eterm erts_error_logger_warnings;
extern int erts_initialized;
extern int erts_compat_rel;
@@ -1101,7 +1126,9 @@ void erts_init_gc(void);
int erts_garbage_collect(Process*, int, Eterm*, int);
void erts_garbage_collect_hibernate(Process* p);
Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity);
-void erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size);
+void erts_garbage_collect_literals(Process* p, Eterm* literals,
+ Uint lit_size,
+ struct erl_off_heap_header* oh);
Uint erts_next_heap_size(Uint, Uint);
Eterm erts_heap_sizes(Process* p);
@@ -1621,8 +1648,7 @@ void monitor_generic(Process *p, Eterm type, Eterm spec);
Uint erts_trace_flag2bit(Eterm flag);
int erts_trace_flags(Eterm List,
Uint *pMask, Eterm *pTracer, int *pCpuTimestamp);
-Eterm erts_bif_trace(int bif_index, Process* p,
- Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I);
+Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I);
#ifdef ERTS_SMP
void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp);
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index fff720634d..132dc78515 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -952,7 +952,7 @@ io_list_to_vec(Eterm obj, /* io-list */
do { \
int _size = binary_size(obj); \
Eterm _real; \
- Uint _offset; \
+ ERTS_DECLARE_DUMMY(Uint _offset); \
int _bitoffs; \
int _bitsize; \
ERTS_GET_REAL_BIN(obj, _real, _offset, _bitoffs, _bitsize); \
@@ -2171,8 +2171,8 @@ erts_port_control(Process* p, Port* prt, Uint command, Eterm iolist)
* and with its length in to_len.
*/
if (is_binary(iolist) && binary_bitoffset(iolist) == 0) {
- Uint bitoffs;
- Uint bitsize;
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
+ ERTS_DECLARE_DUMMY(Uint bitsize);
ERTS_GET_BINARY_BYTES(iolist, to_port, bitoffs, bitsize);
to_len = binary_size(iolist);
} else {
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 304ce22ef2..fc53a88a3a 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -25,30 +25,12 @@
# instruction transformations; thus, they never occur in BEAM files.
#
-# Special instruction used to generate an error message when
-# trying to load a module compiled by the V1 compiler (R5 & R6).
-# (Specially treated in beam_load.c.)
+# The too_old_compiler/0 instruction is specially handled in beam_load.c
+# to produce a user-friendly message informing the user that the module
+# needs to be re-compiled with a modern compiler.
too_old_compiler/0
-too_old_compiler
-
-#
-# Obsolete instruction usage follow. (Nowdays we use f with
-# a zero label instead of p.)
-#
-
-is_list p S => too_old_compiler
-is_nonempty_list p R => too_old_compiler
-is_nil p R => too_old_compiler
-
-is_tuple p S => too_old_compiler
-test_arity p S Arity => too_old_compiler
-
-is_integer p R => too_old_compiler
-is_float p R => too_old_compiler
-is_atom p R => too_old_compiler
-
-is_eq_exact p S1 S2 => too_old_compiler
+too_old_compiler | never() =>
# In R9C and earlier, the loader used to insert special instructions inside
# the module_info/0,1 functions. (In R10B and later, the compiler inserts
@@ -88,12 +70,42 @@ i_time_breakpoint
i_return_time_trace
i_return_to_trace
i_yield
-i_global_cons
-i_global_tuple
-i_global_copy
return
+#
+# To ensure that a "move Src x(0)" instruction can be combined
+# with the following call instruction, we need to make sure that
+# there is no line/1 instruction between the move and the call.
+#
+
+move S r | line Loc | call_ext Ar Func => \
+ line Loc | move S r | call_ext Ar Func
+move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \
+ line Loc | move S r | call_ext_last Ar Func D
+move S r | line Loc | call_ext_only Ar Func=u$is_bif => \
+ line Loc | move S r | call_ext_only Ar Func
+move S r | line Loc | call Ar Func => \
+ line Loc | move S r | call Ar Func
+
+#
+# A tail-recursive call to an external function (non-BIF) will
+# never be saved on the stack, so there is no reason to keep
+# the line instruction. (The compiler did not remove the line
+# instruction because it cannot tell the difference between
+# BIFs and ordinary Erlang functions.)
+#
+
+line Loc | call_ext_last Ar Func=u$is_not_bif D => \
+ call_ext_last Ar Func D
+line Loc | call_ext_only Ar Func=u$is_not_bif => \
+ call_ext_only Ar Func
+
+line Loc | func_info M F A => func_info M F A | line Loc
+
+line I
+
+
%macro: allocate Allocate -pack
%macro: allocate_zero AllocateZero -pack
%macro: allocate_heap AllocateHeap -pack
@@ -277,8 +289,6 @@ raise s s
badarg j
system_limit j
-move R R =>
-
move C=cxy r | jump Lbl => move_jump Lbl C
%macro: move_jump MoveJump -nonext
@@ -585,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg
original_reg Reg Pos =>
-get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
-
original_reg/2
extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
@@ -837,11 +845,11 @@ call_ext_only u==3 u$func:erlang:apply/3 => i_apply_only
# thus there is no need to generate any return instruction.
#
-call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif1 Bif
-call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif1 Bif
+call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif Bif
+call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif Bif
-call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif1 Bif
-call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif
+call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif Bif
+call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif Bif
#
# The error/1 and error/2 BIFs never execute the instruction following them;
@@ -851,13 +859,13 @@ call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif
# the continuation pointer on the stack.
#
-call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif1 Bif
-call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif2 Bif
+call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif Bif
+call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif Bif
call_ext_only Ar=u==1 Bif=u$bif:erlang:error/1 => \
- allocate u Ar | call_bif1 Bif
+ allocate u Ar | call_bif Bif
call_ext_only Ar=u==2 Bif=u$bif:erlang:error/2 => \
- allocate u Ar | call_bif2 Bif
+ allocate u Ar | call_bif Bif
#
# The yield/0 BIF is an instruction
@@ -875,47 +883,18 @@ call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate
call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate
#
-# Hybrid memory architecture need special cons and tuple instructions
-# that allocate on the message area. These looks like BIFs in the BEAM code.
-#
-
-call_ext u==2 u$func:hybrid:cons/2 => i_global_cons
-call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D
-call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return
-
-call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple
-call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D
-call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return
-
-call_ext u==1 u$func:hybrid:copy/1 => i_global_copy
-call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D
-call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return
-
-#
# The general case for BIFs that have no special instructions.
# A BIF used in the tail must be followed by a return instruction.
#
# To make trapping and stack backtraces work correctly, we make sure that
# the continuation pointer is always stored on the stack.
-call_ext u==0 Bif=u$is_bif => call_bif0 Bif
-call_ext u==1 Bif=u$is_bif => call_bif1 Bif
-call_ext u==2 Bif=u$is_bif => call_bif2 Bif
-call_ext u==3 Bif=$is_bif => call_bif3 Bif
+call_ext u Bif=u$is_bif => call_bif Bif
-call_ext_last u==0 Bif=u$is_bif D => call_bif0 Bif | deallocate_return D
-call_ext_last u==1 Bif=u$is_bif D => call_bif1 Bif | deallocate_return D
-call_ext_last u==2 Bif=u$is_bif D => call_bif2 Bif | deallocate_return D
-call_ext_last u==3 Bif=u$is_bif D => call_bif3 Bif | deallocate_return D
+call_ext_last u Bif=u$is_bif D => call_bif Bif | deallocate_return D
-call_ext_only Ar=u==0 Bif=u$is_bif => \
- allocate u Ar | call_bif0 Bif | deallocate_return u
-call_ext_only Ar=u==1 Bif=u$is_bif => \
- allocate u Ar | call_bif1 Bif | deallocate_return u
-call_ext_only Ar=u==2 Bif=u$is_bif => \
- allocate u Ar | call_bif2 Bif | deallocate_return u
-call_ext_only Ar=u==3 Bif=u$is_bif => \
- allocate u Ar | call_bif3 Bif | deallocate_return u
+call_ext_only Ar=u Bif=u$is_bif => \
+ allocate u Ar | call_bif Bif | deallocate_return u
#
# Any remaining calls are calls to Erlang functions, not BIFs.
@@ -928,9 +907,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func
move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r
move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r
-call_ext Ar=u Func => i_call_ext Func
-call_ext_last Ar=u Func D => i_call_ext_last Func D
-call_ext_only Ar=u Func => i_call_ext_only Func
+call_ext Ar Func => i_call_ext Func
+call_ext_last Ar Func D => i_call_ext_last Func D
+call_ext_only Ar Func => i_call_ext_only Func
i_apply
i_apply_last P
@@ -942,10 +921,7 @@ i_apply_fun_only
i_hibernate
-call_bif0 e
-call_bif1 e
-call_bif2 e
-call_bif3 e
+call_bif e
#
# Calls to non-building and guard BIFs.
@@ -964,7 +940,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst
bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst
bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst
-bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
+bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
i_get s d
@@ -1047,8 +1023,8 @@ i_move_call_ext_only e c r
# Fun calls.
-call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D
-call_fun Arity=u => i_call_fun Arity
+call_fun Arity | deallocate D | return => i_call_fun_last Arity D
+call_fun Arity => i_call_fun Arity
i_call_fun I
i_call_fun_last I P
@@ -1304,13 +1280,13 @@ i_bs_utf16_size s d
bs_put_utf8 Fail=j Flags=u Literal=q => \
move Literal x | bs_put_utf8 Fail Flags x
-bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src
+bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
i_bs_put_utf8 j s
bs_put_utf16 Fail=j Flags=u Literal=q => \
move Literal x | bs_put_utf16 Fail Flags x
-bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
+bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
i_bs_put_utf16 j I s
@@ -1475,34 +1451,13 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler
#
# Guard BIFs.
#
-gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \
+gc_bif1 Fail I Bif Src Dst => \
gen_guard_bif1(Fail, I, Bif, Src, Dst)
-gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \
+gc_bif2 Fail I Bif S1 S2 Dst => \
gen_guard_bif2(Fail, I, Bif, S1, S2, Dst)
-gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \
+gc_bif3 Fail I Bif S1 S2 S3 Dst => \
gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D
@@ -1520,6 +1475,15 @@ ii_gc_bif3/7
ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D
i_gc_bif3 j I s I d
+
+#
+# The following instruction is specially handled in beam_load.c
+# to produce a user-friendly message if an unsupported guard BIF is
+# encountered.
+#
+unsupported_guard_bif/3
+unsupported_guard_bif A B C | never() =>
+
#
# R13B03
#
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index f9cbcc5892..94c36c8c59 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -103,6 +103,15 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
# define ERTS_LIKELY(BOOL) (BOOL)
# define ERTS_UNLIKELY(BOOL) (BOOL)
#endif
+#ifdef __GNUC__
+# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5)
+# define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused))
+# else
+# define ERTS_DECLARE_DUMMY(X) X
+# endif
+#else
+# define ERTS_DECLARE_DUMMY(X) X
+#endif
#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
# undef ERTS_CAN_INLINE
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index aa86f4590d..df03f5e42c 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -45,6 +45,7 @@
#include "erl_thr_progress.h"
#include "erl_thr_queue.h"
#include "erl_sched_spec_pre_alloc.h"
+#include "beam_bp.h"
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
@@ -2647,7 +2648,7 @@ tailrecur_ne:
FloatDef f1, f2;
Eterm big;
#if HEAP_ON_C_STACK
- Eterm big_buf[2]; /* If HEAP_ON_C_STACK */
+ Eterm big_buf[CMP_TMP_HEAP_SIZE]; /* If HEAP_ON_C_STACK */
#else
Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap;
#endif
@@ -2658,41 +2659,108 @@ tailrecur_ne:
Eterm aw = a;
Eterm bw = b;
#endif
+#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2))
+#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1))
b_tag = tag_val_def(bw);
switch(_NUMBER_CODE(a_tag, b_tag)) {
case SMALL_BIG:
- big = small_to_big(signed_val(a), big_buf);
- j = big_comp(big, bw);
+ j = big_sign(bw) ? 1 : -1;
+ break;
+ case BIG_SMALL:
+ j = big_sign(aw) ? -1 : 1;
break;
case SMALL_FLOAT:
- f1.fd = signed_val(a);
GET_DOUBLE(bw, f2);
- j = float_comp(f1.fd, f2.fd);
- break;
- case BIG_SMALL:
- big = small_to_big(signed_val(b), big_buf);
- j = big_comp(aw, big);
+ if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ f1.fd = signed_val(aw);
+ j = float_comp(f1.fd, f2.fd);
+#if ERTS_SIZEOF_ETERM == 8
+ } else if (f2.fd > (double) (MAX_SMALL + 1)) {
+ // Float is a positive bignum, i.e. bigger
+ j = -1;
+ } else if (f2.fd < (double) (MIN_SMALL - 1)) {
+ // Float is a negative bignum, i.e. smaller
+ j = 1;
+ } else { // Float is a Sint but less precise
+ j = signed_val(aw) - (Sint) f2.fd;
+ }
+#else
+ } else {
+ // If float is positive it is bigger than small
+ j = (f2.fd > 0.0) ? -1 : 1;
+ }
+#endif // ERTS_SIZEOF_ETERM == 8
break;
case BIG_FLOAT:
- if (big_to_double(aw, &f1.fd) < 0) {
- j = big_sign(a) ? -1 : 1;
+ GET_DOUBLE(bw, f2);
+ if ((f2.fd < (double) (MAX_SMALL + 1))
+ && (f2.fd > (double) (MIN_SMALL - 1))) {
+ // Float is a Sint
+ j = big_sign(aw) ? -1 : 1;
+ } else if ((pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) {
+ // If bignum size shows that it is bigger than the abs float
+ j = big_sign(aw) ? -1 : 1;
+ } else if ((pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) {
+ // If bignum size shows that it is smaller than the abs float
+ j = f2.fd < 0 ? 1 : -1;
+ } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ if (big_to_double(aw, &f1.fd) < 0) {
+ j = big_sign(aw) ? -1 : 1;
+ } else {
+ j = float_comp(f1.fd, f2.fd);
+ }
} else {
- GET_DOUBLE(bw, f2);
- j = float_comp(f1.fd, f2.fd);
+ big = double_to_big(f2.fd, big_buf);
+ j = big_comp(aw, big);
}
break;
case FLOAT_SMALL:
GET_DOUBLE(aw, f1);
- f2.fd = signed_val(b);
- j = float_comp(f1.fd, f2.fd);
+ if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ f2.fd = signed_val(bw);
+ j = float_comp(f1.fd, f2.fd);
+#if ERTS_SIZEOF_ETERM == 8
+ } else if (f1.fd > (double) (MAX_SMALL + 1)) {
+ // Float is a positive bignum, i.e. bigger
+ j = 1;
+ } else if (f1.fd < (double) (MIN_SMALL - 1)) {
+ // Float is a negative bignum, i.e. smaller
+ j = -1;
+ } else { // Float is a Sint but less precise it
+ j = (Sint) f1.fd - signed_val(bw);
+ }
+#else
+ } else {
+ // If float is positive it is bigger than small
+ j = (f1.fd > 0.0) ? 1 : -1;
+ }
+#endif // ERTS_SIZEOF_ETERM == 8
break;
case FLOAT_BIG:
- if (big_to_double(bw, &f2.fd) < 0) {
- j = big_sign(b) ? 1 : -1;
+ GET_DOUBLE(aw, f1);
+ if ((f1.fd < (double) (MAX_SMALL + 1))
+ && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint
+ j = big_sign(bw) ? 1 : -1;
+ } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) {
+ // If bignum size shows that it is bigger than the abs float
+ j = big_sign(bw) ? 1 : -1;
+ } else if ((pow(2.0,(big_arity(bw))*D_EXP)-1.0) < fabs(f1.fd)) {
+ // If bignum size shows that it is smaller than the abs float
+ j = f1.fd < 0 ? -1 : 1;
+ } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ if (big_to_double(bw, &f2.fd) < 0) {
+ j = big_sign(bw) ? 1 : -1;
+ } else {
+ j = float_comp(f1.fd, f2.fd);
+ }
} else {
- GET_DOUBLE(aw, f1);
- j = float_comp(f1.fd, f2.fd);
+ big = double_to_big(f1.fd, big_buf);
+ j = big_comp(big, bw);
}
break;
default:
@@ -2888,14 +2956,14 @@ Eterm
buf_to_intlist(Eterm** hpp, char *buf, int len, Eterm tail)
{
Eterm* hp = *hpp;
+ int i = len - 1;
- buf += (len-1);
- while(len > 0) {
- tail = CONS(hp, make_small((byte)*buf), tail);
+ while(i >= 0) {
+ tail = CONS(hp, make_small((Uint)(byte)buf[i]), tail);
hp += 2;
- buf--;
- len--;
+ --i;
}
+
*hpp = hp;
return tail;
}
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index f0ff3f54c5..901d98c09d 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -69,6 +69,7 @@
#define FILE_RESP_EOF 8
#define FILE_RESP_FNAME 9
#define FILE_RESP_ALL_DATA 10
+#define FILE_RESP_LFNAME 11
/* Options */
@@ -184,6 +185,7 @@ static ErlDrvSysInfo sys_info;
# define RESBUFSIZE BUFSIZ
#endif
+#define READDIR_CHUNKS (5)
@@ -317,15 +319,16 @@ struct t_preadv {
Sint64 offsets[1];
};
-#define READDIR_BUFSIZE (8*1024)
-#if READDIR_BUFSIZE < (FILENAME_CHARSIZE*2*(MAXPATHLEN+1))
+#define READDIR_BUFSIZE (8*1024)*READDIR_CHUNKS
+#if READDIR_BUFSIZE < (1 + (2 + MAXPATHLEN)*FILENAME_CHARSIZE*READDIR_CHUNKS)
# undef READDIR_BUFSIZE
-# define READDIR_BUFSIZE (FILENAME_CHARSIZE*2*(MAXPATHLEN+1))
+# define READDIR_BUFSIZE (1 + (2 + MAXPATHLEN)*FILENAME_CHARSIZE*READDIR_CHUNKS)
#endif
struct t_readdir_buf {
- struct t_readdir_buf *next;
- char buf[READDIR_BUFSIZE];
+ struct t_readdir_buf *next;
+ size_t n;
+ char buf[READDIR_BUFSIZE];
};
struct t_data
@@ -1598,54 +1601,46 @@ static void invoke_lseek(void *data)
static void invoke_readdir(void *data)
{
struct t_data *d = (struct t_data *) data;
- int s;
char *p = NULL;
- int buf_sz = 0;
- size_t tmp_bs;
+ size_t file_bs;
+ size_t n = 0, total = 0;
+ struct t_readdir_buf *b = NULL;
+ int res = 0;
d->again = 0;
d->errInfo.posix_errno = 0;
- while (1) {
- char *str;
- if (buf_sz < (4 /* sz */ + 1 /* cmd */ +
- FILENAME_CHARSIZE*(MAXPATHLEN + 1))) {
- struct t_readdir_buf *b;
- if (p) {
- put_int32(0, p); /* EOB */
- }
- b = EF_SAFE_ALLOC(sizeof(struct t_readdir_buf));
- b->next = NULL;
- if (d->c.read_dir.last_buf)
- d->c.read_dir.last_buf->next = b;
- else
- d->c.read_dir.first_buf = b;
- d->c.read_dir.last_buf = b;
- p = &b->buf[0];
- buf_sz = READDIR_BUFSIZE - 4/* EOB */;
- }
-
- p[4] = FILE_RESP_FNAME;
- buf_sz -= 4 + 1;
- str = p + 4 + 1;
- ASSERT(buf_sz >= MAXPATHLEN + 1);
- tmp_bs = buf_sz;
- s = efile_readdir(&d->errInfo, d->b, &d->dir_handle, str, &tmp_bs);
-
- if (s) {
- put_int32(tmp_bs + 1 /* 1 byte for opcode */, p);
- p += 4 + tmp_bs + 1;
- ASSERT(p == (str + tmp_bs));
- buf_sz -= tmp_bs;
- }
- else {
- put_int32(1, p);
- p += 4 + 1;
- put_int32(0, p); /* EOB */
- d->result_ok = (d->errInfo.posix_errno == 0);
- break;
+ do {
+ total = READDIR_BUFSIZE;
+ n = 1;
+ b = EF_SAFE_ALLOC(sizeof(struct t_readdir_buf));
+ b->next = NULL;
+
+ if (d->c.read_dir.last_buf) {
+ d->c.read_dir.last_buf->next = b;
+ } else {
+ d->c.read_dir.first_buf = b;
}
- }
+ d->c.read_dir.last_buf = b;
+
+ p = &b->buf[0];
+ p[0] = FILE_RESP_LFNAME;
+ file_bs = READDIR_BUFSIZE - n;
+
+ do {
+ res = efile_readdir(&d->errInfo, d->b, &d->dir_handle, p + n + 2, &file_bs);
+
+ if (res) {
+ put_int16((Uint16)file_bs, p + n);
+ n += 2 + file_bs;
+ file_bs = READDIR_BUFSIZE - n;
+ }
+ } while( res && ((total - n - 2) >= MAXPATHLEN*FILENAME_CHARSIZE));
+
+ b->n = n;
+ } while(res);
+
+ d->result_ok = (d->errInfo.posix_errno == 0);
}
static void invoke_open(void *data)
@@ -2053,30 +2048,24 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
free_data(data);
break;
case FILE_READDIR:
- if (!d->result_ok)
+ if (!d->result_ok) {
reply_error(desc, &d->errInfo);
- else {
+ } else {
struct t_readdir_buf *b1 = d->c.read_dir.first_buf;
+ char op = FILE_RESP_LFNAME;
+
TRACE_C('R');
ASSERT(b1);
+
while (b1) {
struct t_readdir_buf *b2 = b1;
char *p = &b1->buf[0];
- int sz = get_int32(p);
- while (sz) { /* 0 == EOB */
- p += 4;
- if (sz - 1 > 0) {
- driver_output2(desc->port, p, 1, p+1, sz-1);
- } else {
- driver_output2(desc->port, p, 1, NULL, 0);
- }
- p += sz;
- sz = get_int32(p);
- }
+ driver_output2(desc->port, p, 1, p + 1, b1->n - 1);
b1 = b1->next;
EF_FREE(b2);
}
-
+ driver_output2(desc->port, &op, 1, NULL, 0);
+
d->c.read_dir.first_buf = NULL;
d->c.read_dir.last_buf = NULL;
}
@@ -2126,6 +2115,7 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
cq_execute(desc);
}
+
/*********************************************************************
* Driver entry point -> output
*/
@@ -2246,19 +2236,46 @@ file_output(ErlDrvData e, char* buf, int count)
#endif
{
size_t resbufsize;
- char resbuf[RESBUFSIZE+1];
+ size_t n = 0, total = 0;
+ int res = 0;
+ char resbuf[READDIR_BUFSIZE];
+
EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */
+ total = READDIR_BUFSIZE;
errInfo.posix_errno = 0;
- dir_handle = NULL;
- resbuf[0] = FILE_RESP_FNAME;
- resbufsize = RESBUFSIZE;
-
- while (efile_readdir(&errInfo, name, &dir_handle,
- resbuf+1, &resbufsize)) {
- driver_output2(desc->port, resbuf, 1, resbuf+1, resbufsize);
- resbufsize = RESBUFSIZE;
- }
+ dir_handle = NULL;
+ resbuf[0] = FILE_RESP_LFNAME;
+
+ /* Fill the buffer with multiple directory listings before sending it to the
+ * receiving process. READDIR_CHUNKS is minimum number of files sent to the
+ * receiver.
+ * Format for each driver_output2:
+ * ------------------------------------
+ * | Type | Len | Filename | ...
+ * | 1 byte | 2 bytes | Len bytes | ...
+ * ------------------------------------
+ */
+
+ do {
+ n = 1;
+ resbufsize = READDIR_BUFSIZE - n;
+
+ do {
+ res = efile_readdir(&errInfo, name, &dir_handle, resbuf + n + 2, &resbufsize);
+
+ if (res) {
+ put_int16((Uint16)resbufsize, resbuf + n);
+ n += 2 + resbufsize;
+ resbufsize = READDIR_BUFSIZE - n;
+ }
+ } while( res && ((total - n - 2) >= MAXPATHLEN*FILENAME_CHARSIZE));
+
+ if (n > 1) {
+ driver_output2(desc->port, resbuf, 1, resbuf + 1, n - 1);
+ }
+ } while(res);
+
if (errInfo.posix_errno != 0) {
reply_error(desc, &errInfo);
return;
@@ -2455,16 +2472,22 @@ file_output(ErlDrvData e, char* buf, int count)
static void
file_flush(ErlDrvData e) {
file_descriptor *desc = (file_descriptor *)e;
+#ifdef DEBUG
int r;
+#endif
TRACE_C('f');
- r = flush_write(desc, NULL);
+#ifdef DEBUG
+ r =
+#endif
+ flush_write(desc, NULL);
/* Only possible reason for bad return value is ENOMEM, and
* there is nobody to tell...
*/
+#ifdef DEBUG
ASSERT(r == 0);
- r = 0; /* Avoiding warning */
+#endif
cq_execute(desc);
}
@@ -2476,13 +2499,20 @@ file_flush(ErlDrvData e) {
static int
file_control(ErlDrvData e, unsigned int command,
char* buf, int len, char **rbuf, int rlen) {
+ /*
+ * warning: variable ‘desc’ set but not used
+ * [-Wunused-but-set-variable]
+ * ... no kidding ...
+ *
+ *
file_descriptor *desc = (file_descriptor *)e;
switch (command) {
default:
return 0;
- } /* switch (command) */
+ }
ASSERT(0);
- desc = NULL; /* XXX Avoid warning while empty switch */
+ desc = NULL;
+ */
return 0;
}
@@ -2507,12 +2537,14 @@ file_timeout(ErlDrvData e) {
driver_async(desc->port, KEY(desc), desc->invoke, desc->d, desc->free);
break;
case timer_write: {
- int r = flush_write(desc, NULL);
+#ifdef DEBUG
+ int r =
+#endif
+ flush_write(desc, NULL);
/* Only possible reason for bad return value is ENOMEM, and
* there is nobody to tell...
*/
ASSERT(r == 0);
- r = 0; /* Avoiding warning */
cq_execute(desc);
} break;
} /* case */
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 43114c6039..db052523a8 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -280,6 +280,57 @@ static unsigned long one_value = 1;
# define SCTP_EOF MSG_EOF
#endif
+/* More Solaris 10 fixes: */
+#if ! HAVE_DECL_SCTP_CLOSED && HAVE_DECL_SCTPS_IDLE
+# define SCTP_CLOSED SCTPS_IDLE
+# undef HAVE_DECL_SCTP_CLOSED
+# define HAVE_DECL_SCTP_CLOSED 1
+#endif
+#if ! HAVE_DECL_SCTP_BOUND && HAVE_DECL_SCTPS_BOUND
+# define SCTP_BOUND SCTPS_BOUND
+# undef HAVE_DECL_SCTP_BOUND
+# define HAVE_DECL_SCTP_BOUND 1
+#endif
+#if ! HAVE_DECL_SCTP_LISTEN && HAVE_DECL_SCTPS_LISTEN
+# define SCTP_LISTEN SCTPS_LISTEN
+# undef HAVE_DECL_SCTP_LISTEN
+# define HAVE_DECL_SCTP_LISTEN 1
+#endif
+#if ! HAVE_DECL_SCTP_COOKIE_WAIT && HAVE_DECL_SCTPS_COOKIE_WAIT
+# define SCTP_COOKIE_WAIT SCTPS_COOKIE_WAIT
+# undef HAVE_DECL_SCTP_COOKIE_WAIT
+# define HAVE_DECL_SCTP_COOKIE_WAIT 1
+#endif
+#if ! HAVE_DECL_SCTP_COOKIE_ECHOED && HAVE_DECL_SCTPS_COOKIE_ECHOED
+# define SCTP_COOKIE_ECHOED SCTPS_COOKIE_ECHOED
+# undef HAVE_DECL_SCTP_COOKIE_ECHOED
+# define HAVE_DECL_SCTP_COOKIE_ECHOED 1
+#endif
+#if ! HAVE_DECL_SCTP_ESTABLISHED && HAVE_DECL_SCTPS_ESTABLISHED
+# define SCTP_ESTABLISHED SCTPS_ESTABLISHED
+# undef HAVE_DECL_SCTP_ESTABLISHED
+# define HAVE_DECL_SCTP_ESTABLISHED 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_PENDING && HAVE_DECL_SCTPS_SHUTDOWN_PENDING
+# define SCTP_SHUTDOWN_PENDING SCTPS_SHUTDOWN_PENDING
+# undef HAVE_DECL_SCTP_SHUTDOWN_PENDING
+# define HAVE_DECL_SCTP_SHUTDOWN_PENDING 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_SENT && HAVE_DECL_SCTPS_SHUTDOWN_SENT
+# define SCTP_SHUTDOWN_SENT SCTPS_SHUTDOWN_SENT
+# undef HAVE_DECL_SCTP_SHUTDOWN_SENT
+# define HAVE_DECL_SCTP_SHUTDOWN_SENT 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_RECEIVED && HAVE_DECL_SCTPS_SHUTDOWN_RECEIVED
+# define SCTP_SHUTDOWN_RECEIVED SCTPS_SHUTDOWN_RECEIVED
+# undef HAVE_DECL_SCTP_SHUTDOWN_RECEIVED
+# define HAVE_DECL_SCTP_SHUTDOWN_RECEIVED 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_ACK_SENT && HAVE_DECL_SCTPS_SHUTDOWN_ACK_SENT
+# define SCTP_SHUTDOWN_ACK_SENT SCTPS_SHUTDOWN_ACK_SENT
+# undef HAVE_DECL_SCTP_SHUTDOWN_ACK_SENT
+# define HAVE_DECL_SCTP_SHUTDOWN_ACK_SENT 1
+#endif
/* New spelling in lksctp 2.6.22 or maybe even earlier:
* adaption -> adaptation
*/
@@ -294,12 +345,13 @@ static unsigned long one_value = 1;
# define sctp_adaptation_layer_event sctp_adaption_layer_event
#endif
-static void *h_libsctp = NULL;
#ifdef __GNUC__
static typeof(sctp_bindx) *p_sctp_bindx = NULL;
+static typeof(sctp_peeloff) *p_sctp_peeloff = NULL;
#else
static int (*p_sctp_bindx)(int sd, struct sockaddr *addrs,
int addrcnt, int flags) = NULL;
+static int (*p_sctp_peeloff)(int sd, sctp_assoc_t assoc_id) = NULL;
#endif
#endif /* SCTP supported */
@@ -427,7 +479,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define INET_AF_ANY 3 /* INADDR_ANY or IN6ADDR_ANY_INIT */
#define INET_AF_LOOPBACK 4 /* INADDR_LOOPBACK or IN6ADDR_LOOPBACK_INIT */
-/* INET_REQ_GETTYPE enumeration */
+/* open and INET_REQ_GETTYPE enumeration */
#define INET_TYPE_STREAM 1
#define INET_TYPE_DGRAM 2
#define INET_TYPE_SEQPACKET 3
@@ -484,16 +536,19 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define INET_REQ_IFSET 23
#define INET_REQ_SUBSCRIBE 24
#define INET_REQ_GETIFADDRS 25
+#define INET_REQ_ACCEPT 26
+#define INET_REQ_LISTEN 27
/* TCP requests */
-#define TCP_REQ_ACCEPT 40
-#define TCP_REQ_LISTEN 41
+/* #define TCP_REQ_ACCEPT 40 MOVED */
+/* #define TCP_REQ_LISTEN 41 MERGED */
#define TCP_REQ_RECV 42
#define TCP_REQ_UNRECV 43
#define TCP_REQ_SHUTDOWN 44
/* UDP and SCTP requests */
#define PACKET_REQ_RECV 60 /* Common for UDP and SCTP */
-#define SCTP_REQ_LISTEN 61 /* Different from TCP; not for UDP */
+/* #define SCTP_REQ_LISTEN 61 MERGED Different from TCP; not for UDP */
#define SCTP_REQ_BINDX 62 /* Multi-home SCTP bind */
+#define SCTP_REQ_PEELOFF 63
/* INET_REQ_SUBSCRIBE sub-requests */
#define INET_SUBS_EMPTY_OUT_Q 1
@@ -507,7 +562,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
/* *_REQ_* replies */
#define INET_REP_ERROR 0
#define INET_REP_OK 1
-#define INET_REP_SCTP 2
+#define INET_REP 2
/* INET_REQ_SETOPTS and INET_REQ_GETOPTS options */
#define INET_OPT_REUSEADDR 0 /* enable/disable local address reuse */
@@ -628,10 +683,14 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
** End of interface constants.
**--------------------------------------------------------------------------*/
-#define INET_STATE_CLOSED 0
-#define INET_STATE_OPEN (INET_F_OPEN)
-#define INET_STATE_BOUND (INET_STATE_OPEN | INET_F_BOUND)
-#define INET_STATE_CONNECTED (INET_STATE_BOUND | INET_F_ACTIVE)
+#define INET_STATE_CLOSED (0)
+#define INET_STATE_OPEN (INET_F_OPEN)
+#define INET_STATE_BOUND (INET_STATE_OPEN | INET_F_BOUND)
+#define INET_STATE_CONNECTED (INET_STATE_BOUND | INET_F_ACTIVE)
+#define INET_STATE_LISTENING (INET_STATE_BOUND | INET_F_LISTEN)
+#define INET_STATE_CONNECTING (INET_STATE_BOUND | INET_F_CON)
+#define INET_STATE_ACCEPTING (INET_STATE_LISTENING | INET_F_ACC)
+#define INET_STATE_MULTI_ACCEPTING (INET_STATE_ACCEPTING | INET_F_MULTI_CLIENT)
#define IS_OPEN(d) \
(((d)->state & INET_F_OPEN) == INET_F_OPEN)
@@ -674,7 +733,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#endif
-#define BIN_REALLOC_LIMIT(x) (((x)*3)/4) /* 75% */
+#define BIN_REALLOC_MARGIN(x) ((x)/4) /* 25% */
/* The general purpose sockaddr */
typedef union {
@@ -809,16 +868,6 @@ typedef struct {
-#define TCP_STATE_CLOSED INET_STATE_CLOSED
-#define TCP_STATE_OPEN (INET_F_OPEN)
-#define TCP_STATE_BOUND (TCP_STATE_OPEN | INET_F_BOUND)
-#define TCP_STATE_CONNECTED (TCP_STATE_BOUND | INET_F_ACTIVE)
-#define TCP_STATE_LISTEN (TCP_STATE_BOUND | INET_F_LISTEN)
-#define TCP_STATE_CONNECTING (TCP_STATE_BOUND | INET_F_CON)
-#define TCP_STATE_ACCEPTING (TCP_STATE_LISTEN | INET_F_ACC)
-#define TCP_STATE_MULTI_ACCEPTING (TCP_STATE_ACCEPTING | INET_F_MULTI_CLIENT)
-
-
#define TCP_MAX_PACKET_SIZE 0x4000000 /* 64 M */
#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
@@ -874,12 +923,6 @@ static struct erl_drv_entry tcp_inet_driver_entry =
inet_stop_select
};
-#define PACKET_STATE_CLOSED INET_STATE_CLOSED
-#define PACKET_STATE_OPEN (INET_F_OPEN)
-#define PACKET_STATE_BOUND (PACKET_STATE_OPEN | INET_F_BOUND)
-#define SCTP_STATE_LISTEN (PACKET_STATE_BOUND | INET_F_LISTEN)
-#define SCTP_STATE_CONNECTING (PACKET_STATE_BOUND | INET_F_CON)
-#define PACKET_STATE_CONNECTED (PACKET_STATE_BOUND | INET_F_ACTIVE)
static int packet_inet_init(void);
@@ -997,6 +1040,9 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event);
typedef struct {
inet_descriptor inet; /* common data structure (DON'T MOVE) */
int read_packets; /* Number of packets to read per invocation */
+ int i_bufsz; /* current input buffer size */
+ ErlDrvBinary* i_buf; /* current binary buffer */
+ char* i_ptr; /* current pos in buf */
} udp_descriptor;
@@ -1851,6 +1897,26 @@ static int inet_reply_ok(inet_descriptor* desc)
return driver_send_term(desc->port, caller, spec, i);
}
+#ifdef HAVE_SCTP
+static int inet_reply_ok_port(inet_descriptor* desc, ErlDrvTermData dport)
+{
+ ErlDrvTermData spec[2*LOAD_ATOM_CNT + 2*LOAD_PORT_CNT + 2*LOAD_TUPLE_CNT];
+ ErlDrvTermData caller = desc->caller;
+ int i = 0;
+
+ i = LOAD_ATOM(spec, i, am_inet_reply);
+ i = LOAD_PORT(spec, i, desc->dport);
+ i = LOAD_ATOM(spec, i, am_ok);
+ i = LOAD_PORT(spec, i, dport);
+ i = LOAD_TUPLE(spec, i, 2);
+ i = LOAD_TUPLE(spec, i, 3);
+ ASSERT(i == sizeof(spec)/sizeof(*spec));
+
+ desc->caller = 0;
+ return driver_send_term(desc->port, caller, spec, i);
+}
+#endif
+
/* send:
** {inet_reply, S, {error, Reason}}
*/
@@ -2389,14 +2455,19 @@ static ErlDrvTermData am_sctp_rtoinfo, /* Option names */
am_active, am_inactive,
/* For #sctp_status{}: */
- am_empty, am_closed,
+# if HAVE_DECL_SCTP_EMPTY
+ am_empty,
+# endif
+# if HAVE_DECL_SCTP_BOUND
+ am_bound,
+# endif
+# if HAVE_DECL_SCTP_LISTEN
+ am_listen,
+# endif
am_cookie_wait, am_cookie_echoed,
am_established, am_shutdown_pending,
am_shutdown_sent, am_shutdown_received,
am_shutdown_ack_sent;
- /* Not yet implemented in the Linux kernel:
- ** am_bound, am_listen;
- */
/*
** Parsing of "sctp_sndrcvinfo": ancillary data coming with received msgs.
@@ -2665,7 +2736,8 @@ static int sctp_parse_async_event
# ifdef HAVE_STRUCT_SCTP_REMOTE_ERROR_SRE_DATA
chunk = (char*) (&(sptr->sre_data));
# else
- chunk = ((char*)sptr) + sizeof(*sptr);
+ chunk = ((char*) &(sptr->sre_assoc_id))
+ + sizeof(sptr->sre_assoc_id);
# endif
chlen = sptr->sre_length - (chunk - (char *)sptr);
i = sctp_parse_error_chunk(spec, i, chunk, chlen);
@@ -2716,7 +2788,8 @@ static int sctp_parse_async_event
# ifdef HAVE_STRUCT_SCTP_SEND_FAILED_SSF_DATA
chunk = (char*) (&(sptr->ssf_data));
# else
- chunk = ((char*)sptr) + sizeof(*sptr);
+ chunk = ((char*) &(sptr->ssf_assoc_id))
+ + sizeof(sptr->ssf_assoc_id);
# endif
chlen = sptr->ssf_length - (chunk - (char*) sptr);
choff = chunk - bin->orig_bytes;
@@ -3390,8 +3463,15 @@ static void inet_init_sctp(void) {
INIT_ATOM(inactive);
/* For #sctp_status{}: */
+# if HAVE_DECL_SCTP_EMPTY
INIT_ATOM(empty);
- INIT_ATOM(closed);
+# endif
+# if HAVE_DECL_SCTP_BOUND
+ INIT_ATOM(bound);
+# endif
+# if HAVE_DECL_SCTP_LISTEN
+ INIT_ATOM(listen);
+# endif
INIT_ATOM(cookie_wait);
INIT_ATOM(cookie_echoed);
INIT_ATOM(established);
@@ -3399,10 +3479,6 @@ static void inet_init_sctp(void) {
INIT_ATOM(shutdown_sent);
INIT_ATOM(shutdown_received);
INIT_ATOM(shutdown_ack_sent);
- /* Not yet implemented in the Linux kernel:
- ** INIT_ATOM(bound);
- ** INIT_ATOM(listen);
- */
}
#endif /* HAVE_SCTP */
@@ -3453,17 +3529,32 @@ static int inet_init()
/* Check the size of SCTP AssocID -- currently both this driver and the
Erlang part require 32 bit: */
ASSERT(sizeof(sctp_assoc_t)==ASSOC_ID_LEN);
-# ifndef LIBSCTP
-# error LIBSCTP not defined
-# endif
- if (erts_sys_ddll_open_noext(STRINGIFY(LIBSCTP), &h_libsctp, NULL) == 0) {
- void *ptr;
- if (erts_sys_ddll_sym(h_libsctp, "sctp_bindx", &ptr) == 0) {
- p_sctp_bindx = ptr;
- inet_init_sctp();
- add_driver_entry(&sctp_inet_driver_entry);
+# if defined(HAVE_SCTP_BINDX) && defined (HAVE_SCTP_PEELOFF)
+ p_sctp_bindx = sctp_bindx;
+ p_sctp_peeloff = sctp_peeloff;
+ inet_init_sctp();
+ add_driver_entry(&sctp_inet_driver_entry);
+# else
+# ifndef LIBSCTP
+# error LIBSCTP not defined
+# endif
+ {
+ static void *h_libsctp = NULL;
+
+ if (erts_sys_ddll_open_noext(STRINGIFY(LIBSCTP), &h_libsctp, NULL)
+ == 0) {
+ void *ptr;
+ if (erts_sys_ddll_sym(h_libsctp, "sctp_bindx", &ptr) == 0) {
+ p_sctp_bindx = ptr;
+ inet_init_sctp();
+ add_driver_entry(&sctp_inet_driver_entry);
+ if (erts_sys_ddll_sym(h_libsctp, "sctp_peeloff", &ptr) == 0) {
+ p_sctp_peeloff = ptr;
+ }
+ }
}
}
+# endif
#endif
/* remove the dummy inet driver */
@@ -4131,6 +4222,31 @@ static int inet_ctl_getiflist(inet_descriptor* desc, char** rbuf, int rsize)
return sp - sbuf;
}
+#ifdef HAVE_LIBDLPI_H
+#include <libdlpi.h>
+static int hwaddr_libdlpi_lookup(const char *ifnm,
+ uchar_t *addr, size_t *alen)
+{
+ dlpi_handle_t handle;
+ dlpi_info_t linkinfo;
+ int ret = -1;
+
+ if (dlpi_open(ifnm, &handle, 0) != DLPI_SUCCESS) {
+ return -1;
+ }
+
+ if (dlpi_get_physaddr(handle, DL_CURR_PHYS_ADDR,
+ addr, alen) == DLPI_SUCCESS &&
+ dlpi_info(handle, &linkinfo, 0) == DLPI_SUCCESS)
+ {
+ ret = 0;
+ }
+
+ dlpi_close(handle);
+ return ret;
+}
+#endif
+
/* FIXME: temporary hack */
#ifndef IFHWADDRLEN
#define IFHWADDRLEN 6
@@ -4166,7 +4282,24 @@ static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len,
break;
case INET_IFOPT_HWADDR: {
-#ifdef SIOCGIFHWADDR
+#ifdef HAVE_LIBDLPI_H
+ /*
+ ** OpenSolaris have SIGCGIFHWADDR, but no ifr_hwaddr member..
+ ** The proper way to get the mac address would be to
+ ** use libdlpi...
+ */
+ uchar_t addr[DLPI_PHYSADDR_MAX];
+ size_t alen = sizeof(addr);
+
+ if (hwaddr_libdlpi_lookup(ifreq.ifr_name, addr, &alen) == 0) {
+ buf_check(sptr, s_end, 1+2+alen);
+ *sptr++ = INET_IFOPT_HWADDR;
+ put_int16(alen, sptr);
+ sptr += 2;
+ sys_memcpy(sptr, addr, alen);
+ sptr += alen;
+ }
+#elif defined(SIOCGIFHWADDR) && defined(HAVE_STRUCT_IFREQ_IFR_HWADDR)
if (ioctl(desc->s, SIOCGIFHWADDR, (char *)&ifreq) < 0)
break;
buf_check(sptr, s_end, 1+2+IFHWADDRLEN);
@@ -4175,7 +4308,7 @@ static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len,
/* raw memcpy (fix include autoconf later) */
sys_memcpy(sptr, (char*)(&ifreq.ifr_hwaddr.sa_data), IFHWADDRLEN);
sptr += IFHWADDRLEN;
-#elif defined(SIOCGENADDR)
+#elif defined(SIOCGENADDR) && defined(HAVE_STRUCT_IFREQ_IFR_ENADDR)
if (ioctl(desc->s, SIOCGENADDR, (char *)&ifreq) < 0)
break;
buf_check(sptr, s_end, 1+2+sizeof(ifreq.ifr_enaddr));
@@ -4459,6 +4592,7 @@ static int inet_ctl_ifset(inet_descriptor* desc, char* buf, int len,
+#if defined(__WIN32__) || defined(HAVE_GETIFADDRS)
/* Latin-1 to utf8 */
static int utf8_len(const char *c, int m) {
@@ -4481,6 +4615,7 @@ static void utf8_encode(const char *c, int m, char *p) {
}
}
}
+#endif
#if defined(__WIN32__)
@@ -6736,7 +6871,7 @@ static int sctp_fill_opts(inet_descriptor* desc, char* buf, int buflen,
2*LOAD_ATOM_CNT + LOAD_INT_CNT + 2*LOAD_TUPLE_CNT);
i = LOAD_ATOM (spec, i, am_sctp_adaptation_layer);
i = LOAD_ATOM (spec, i, am_sctp_setadaptation);
- i = LOAD_INT (spec, i, ad.ssb_adaptation_ind);
+ i = LOAD_INT (spec, i, sock_ntohl(ad.ssb_adaptation_ind));
i = LOAD_TUPLE (spec, i, 2);
i = LOAD_TUPLE (spec, i, 2);
break;
@@ -6879,7 +7014,7 @@ static int sctp_fill_opts(inet_descriptor* desc, char* buf, int buflen,
break;
}
/* The following option is not available in Solaris 10: */
-# ifdef SCTP_DELAYED_ACK_TIME
+# if HAVE_DECL_SCTP_DELAYED_ACK_TIME
case SCTP_OPT_DELAYED_ACK_TIME:
{
struct sctp_assoc_value av;
@@ -6926,7 +7061,7 @@ static int sctp_fill_opts(inet_descriptor* desc, char* buf, int buflen,
switch(st.sstat_state)
{
/* SCTP_EMPTY is not supported on SOLARIS10: */
-# ifdef SCTP_EMPTY
+# if HAVE_DECL_SCTP_EMPTY
case SCTP_EMPTY:
i = LOAD_ATOM (spec, i, am_empty);
break;
@@ -6934,14 +7069,16 @@ static int sctp_fill_opts(inet_descriptor* desc, char* buf, int buflen,
case SCTP_CLOSED:
i = LOAD_ATOM (spec, i, am_closed);
break;
- /* The following states are not supported by Linux Kernel SCTP yet:
+# if HAVE_DECL_SCTP_BOUND
case SCTP_BOUND:
i = LOAD_ATOM (spec, i, am_bound);
break;
+# endif
+# if HAVE_DECL_SCTP_LISTEN
case SCTP_LISTEN:
i = LOAD_ATOM (spec, i, am_listen);
break;
- */
+# endif
case SCTP_COOKIE_WAIT:
i = LOAD_ATOM (spec, i, am_cookie_wait);
break;
@@ -7032,7 +7169,7 @@ static int sctp_fill_opts(inet_descriptor* desc, char* buf, int buflen,
driver_send_term(desc->port, driver_caller(desc->port), spec, i);
FREE(spec);
- (*dest)[0] = INET_REP_SCTP;
+ (*dest)[0] = INET_REP;
return 1; /* Response length */
# undef PLACE_FOR
# undef RETURN_ERROR
@@ -7807,22 +7944,22 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s,
static void tcp_close_check(tcp_descriptor* desc)
{
/* XXX:PaN - multiple clients to handle! */
- if (desc->inet.state == TCP_STATE_ACCEPTING) {
+ if (desc->inet.state == INET_STATE_ACCEPTING) {
inet_async_op *this_op = desc->inet.opt;
sock_select(INETP(desc), FD_ACCEPT, 0);
- desc->inet.state = TCP_STATE_LISTEN;
+ desc->inet.state = INET_STATE_LISTENING;
if (this_op != NULL) {
driver_demonitor_process(desc->inet.port, &(this_op->monitor));
}
async_error_am(INETP(desc), am_closed);
}
- else if (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) {
+ else if (desc->inet.state == INET_STATE_MULTI_ACCEPTING) {
int id,req;
ErlDrvTermData caller;
ErlDrvMonitor monitor;
sock_select(INETP(desc), FD_ACCEPT, 0);
- desc->inet.state = TCP_STATE_LISTEN;
+ desc->inet.state = INET_STATE_LISTENING;
while (deq_multi_op(desc,&id,&req,&caller,NULL,&monitor) == 0) {
driver_demonitor_process(desc->inet.port, &monitor);
send_async_error(desc->inet.port, desc->inet.dport, id, caller, am_closed);
@@ -7830,10 +7967,10 @@ static void tcp_close_check(tcp_descriptor* desc)
clean_multi_timers(&(desc->mtd), desc->inet.port);
}
- else if (desc->inet.state == TCP_STATE_CONNECTING) {
+ else if (desc->inet.state == INET_STATE_CONNECTING) {
async_error_am(INETP(desc), am_closed);
}
- else if (desc->inet.state == TCP_STATE_CONNECTED) {
+ else if (desc->inet.state == INET_STATE_CONNECTED) {
async_error_am_all(INETP(desc), am_closed);
}
}
@@ -7865,40 +8002,62 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
{
tcp_descriptor* desc = (tcp_descriptor*)e;
switch(cmd) {
- case INET_REQ_OPEN: /* open socket and return internal index */
+ case INET_REQ_OPEN: { /* open socket and return internal index */
+ int domain;
DEBUGF(("tcp_inet_ctl(%ld): OPEN\r\n", (long)desc->inet.port));
- if ((len == 1) && (buf[0] == INET_AF_INET))
- return
- inet_ctl_open(INETP(desc), AF_INET, SOCK_STREAM, rbuf, rsize);
+ if (len != 2) return ctl_error(EINVAL, rbuf, rsize);
+ switch(buf[0]) {
+ case INET_AF_INET:
+ domain = AF_INET;
+ break;
#if defined(HAVE_IN6) && defined(AF_INET6)
- else if ((len == 1) && (buf[0] == INET_AF_INET6))
- return
- inet_ctl_open(INETP(desc), AF_INET6, SOCK_STREAM, rbuf, rsize);
+ case INET_AF_INET6:
+ domain = AF_INET6;
+ break;
#else
- else if ((len == 1) && (buf[0] == INET_AF_INET6))
- return ctl_xerror("eafnosupport",rbuf,rsize);
+ case INET_AF_INET6:
+ return ctl_xerror("eafnosupport", rbuf, rsize);
+ break;
#endif
- else
+ default:
return ctl_error(EINVAL, rbuf, rsize);
+ }
+ if (buf[1] != INET_TYPE_STREAM) return ctl_error(EINVAL, rbuf, rsize);
+ return inet_ctl_open(INETP(desc), domain, SOCK_STREAM, rbuf, rsize);
+ break;
+ }
- case INET_REQ_FDOPEN: /* pass in an open socket */
- DEBUGF(("tcp_inet_ctl(%ld): FDOPEN\r\n", (long)desc->inet.port));
- if ((len == 5) && (buf[0] == INET_AF_INET))
- return inet_ctl_fdopen(INETP(desc), AF_INET, SOCK_STREAM,
- (SOCKET) get_int32(buf+1), rbuf, rsize);
+ case INET_REQ_FDOPEN: { /* pass in an open socket */
+ int domain;
+ DEBUGF(("tcp_inet_ctl(%ld): FDOPEN\r\n", (long)desc->inet.port));
+ if (len != 6) return ctl_error(EINVAL, rbuf, rsize);
+ switch(buf[0]) {
+ case INET_AF_INET:
+ domain = AF_INET;
+ break;
#if defined(HAVE_IN6) && defined(AF_INET6)
- else if ((len == 5) && (buf[0] == INET_AF_INET6))
- return inet_ctl_fdopen(INETP(desc), AF_INET6, SOCK_STREAM,
- (SOCKET) get_int32(buf+1), rbuf, rsize);
+ case INET_AF_INET6:
+ domain = AF_INET6;
+ break;
+#else
+ case INET_AF_INET6:
+ return ctl_xerror("eafnosupport", rbuf, rsize);
+ break;
#endif
- else
+ default:
return ctl_error(EINVAL, rbuf, rsize);
+ }
+ if (buf[1] != INET_TYPE_STREAM) return ctl_error(EINVAL, rbuf, rsize);
+ return inet_ctl_fdopen(INETP(desc), domain, SOCK_STREAM,
+ (SOCKET) get_int32(buf+2), rbuf, rsize);
+ break;
+ }
- case TCP_REQ_LISTEN: { /* argument backlog */
+ case INET_REQ_LISTEN: { /* argument backlog */
int backlog;
DEBUGF(("tcp_inet_ctl(%ld): LISTEN\r\n", (long)desc->inet.port));
- if (desc->inet.state == TCP_STATE_CLOSED)
+ if (desc->inet.state == INET_STATE_CLOSED)
return ctl_xerror(EXBADPORT, rbuf, rsize);
if (!IS_OPEN(INETP(desc)))
return ctl_xerror(EXBADPORT, rbuf, rsize);
@@ -7909,7 +8068,7 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
backlog = get_int16(buf);
if (IS_SOCKET_ERROR(sock_listen(desc->inet.s, backlog)))
return ctl_error(sock_errno(), rbuf, rsize);
- desc->inet.state = TCP_STATE_LISTEN;
+ desc->inet.state = INET_STATE_LISTENING;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
@@ -7945,13 +8104,13 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
((sock_errno() == ERRNO_BLOCK) || /* Winsock2 */
(sock_errno() == EINPROGRESS))) { /* Unix & OSE!! */
sock_select(INETP(desc), FD_CONNECT, 1);
- desc->inet.state = TCP_STATE_CONNECTING;
+ desc->inet.state = INET_STATE_CONNECTING;
if (timeout != INET_INFINITY)
driver_set_timer(desc->inet.port, timeout);
enq_async(INETP(desc), tbuf, INET_REQ_CONNECT);
}
else if (code == 0) { /* ok we are connected */
- desc->inet.state = TCP_STATE_CONNECTED;
+ desc->inet.state = INET_STATE_CONNECTED;
if (desc->inet.active)
sock_select(INETP(desc), (FD_READ|FD_CLOSE), 1);
enq_async(INETP(desc), tbuf, INET_REQ_CONNECT);
@@ -7963,7 +8122,7 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
}
- case TCP_REQ_ACCEPT: { /* do async accept */
+ case INET_REQ_ACCEPT: { /* do async accept */
char tbuf[2];
unsigned timeout;
inet_address remote;
@@ -7973,14 +8132,14 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
DEBUGF(("tcp_inet_ctl(%ld): ACCEPT\r\n", (long)desc->inet.port));
/* INPUT: Timeout(4) */
- if ((desc->inet.state != TCP_STATE_LISTEN && desc->inet.state != TCP_STATE_ACCEPTING &&
- desc->inet.state != TCP_STATE_MULTI_ACCEPTING) || len != 4) {
+ if ((desc->inet.state != INET_STATE_LISTENING && desc->inet.state != INET_STATE_ACCEPTING &&
+ desc->inet.state != INET_STATE_MULTI_ACCEPTING) || len != 4) {
return ctl_error(EINVAL, rbuf, rsize);
}
timeout = get_int32(buf);
- if (desc->inet.state == TCP_STATE_ACCEPTING) {
+ if (desc->inet.state == INET_STATE_ACCEPTING) {
unsigned long time_left = 0;
int oid = 0;
ErlDrvTermData ocaller = ERL_DRV_NIL;
@@ -8009,10 +8168,10 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
mtd = add_multi_timer(&(desc->mtd), desc->inet.port, caller,
timeout, &tcp_inet_multi_timeout);
}
- enq_multi_op(desc, tbuf, TCP_REQ_ACCEPT, caller, mtd, &monitor);
- desc->inet.state = TCP_STATE_MULTI_ACCEPTING;
+ enq_multi_op(desc, tbuf, INET_REQ_ACCEPT, caller, mtd, &monitor);
+ desc->inet.state = INET_STATE_MULTI_ACCEPTING;
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
- } else if (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) {
+ } else if (desc->inet.state == INET_STATE_MULTI_ACCEPTING) {
ErlDrvTermData caller = driver_caller(desc->inet.port);
MultiTimerData *mtd = NULL;
ErlDrvMonitor monitor;
@@ -8024,7 +8183,7 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
mtd = add_multi_timer(&(desc->mtd), desc->inet.port, caller,
timeout, &tcp_inet_multi_timeout);
}
- enq_multi_op(desc, tbuf, TCP_REQ_ACCEPT, caller, mtd, &monitor);
+ enq_multi_op(desc, tbuf, INET_REQ_ACCEPT, caller, mtd, &monitor);
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
} else {
n = sizeof(desc->inet.remote);
@@ -8036,8 +8195,8 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
&monitor) != 0) {
return ctl_xerror("noproc", rbuf, rsize);
}
- enq_async_w_tmo(INETP(desc), tbuf, TCP_REQ_ACCEPT, timeout, &monitor);
- desc->inet.state = TCP_STATE_ACCEPTING;
+ enq_async_w_tmo(INETP(desc), tbuf, INET_REQ_ACCEPT, timeout, &monitor);
+ desc->inet.state = INET_STATE_ACCEPTING;
sock_select(INETP(desc),FD_ACCEPT,1);
if (timeout != INET_INFINITY) {
driver_set_timer(desc->inet.port, timeout);
@@ -8064,8 +8223,8 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
driver_select(accept_desc->inet.port, accept_desc->inet.event,
ERL_DRV_READ, 1);
#endif
- accept_desc->inet.state = TCP_STATE_CONNECTED;
- enq_async(INETP(desc), tbuf, TCP_REQ_ACCEPT);
+ accept_desc->inet.state = INET_STATE_CONNECTED;
+ enq_async(INETP(desc), tbuf, INET_REQ_ACCEPT);
async_ok_port(INETP(desc), accept_desc->inet.dport);
}
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
@@ -8171,7 +8330,7 @@ static void tcp_inet_timeout(ErlDrvData e)
(long)desc->inet.port, desc->inet.s));
if ((state & INET_F_MULTI_CLIENT)) { /* Multi-client always means multi-timers */
fire_multi_timers(&(desc->mtd), desc->inet.port, e);
- } else if ((state & TCP_STATE_CONNECTED) == TCP_STATE_CONNECTED) {
+ } else if ((state & INET_STATE_CONNECTED) == INET_STATE_CONNECTED) {
if (desc->busy_on_send) {
ASSERT(IS_BUSY(INETP(desc)));
desc->inet.caller = desc->inet.busy_caller;
@@ -8191,20 +8350,20 @@ static void tcp_inet_timeout(ErlDrvData e)
async_error_am(INETP(desc), am_timeout);
}
}
- else if ((state & TCP_STATE_CONNECTING) == TCP_STATE_CONNECTING) {
+ else if ((state & INET_STATE_CONNECTING) == INET_STATE_CONNECTING) {
/* assume connect timeout */
/* close the socket since it's not usable (see man pages) */
erl_inet_close(INETP(desc));
async_error_am(INETP(desc), am_timeout);
}
- else if ((state & TCP_STATE_ACCEPTING) == TCP_STATE_ACCEPTING) {
+ else if ((state & INET_STATE_ACCEPTING) == INET_STATE_ACCEPTING) {
inet_async_op *this_op = desc->inet.opt;
/* timer is set on accept */
sock_select(INETP(desc), FD_ACCEPT, 0);
if (this_op != NULL) {
driver_demonitor_process(desc->inet.port, &(this_op->monitor));
}
- desc->inet.state = TCP_STATE_LISTEN;
+ desc->inet.state = INET_STATE_LISTENING;
async_error_am(INETP(desc), am_timeout);
}
DEBUGF(("tcp_inet_timeout(%ld) }\r\n", (long)desc->inet.port));
@@ -8222,7 +8381,7 @@ static void tcp_inet_multi_timeout(ErlDrvData e, ErlDrvTermData caller)
driver_demonitor_process(desc->inet.port, &monitor);
if (desc->multi_first == NULL) {
sock_select(INETP(desc),FD_ACCEPT,0);
- desc->inet.state = TCP_STATE_LISTEN; /* restore state */
+ desc->inet.state = INET_STATE_LISTENING; /* restore state */
}
send_async_error(desc->inet.port, desc->inet.dport, id, caller, am_timeout);
}
@@ -8288,7 +8447,7 @@ static void tcp_inet_process_exit(ErlDrvData e, ErlDrvMonitor *monitorp)
ErlDrvTermData who = driver_get_monitored_process(desc->inet.port,monitorp);
int state = desc->inet.state;
- if ((state & TCP_STATE_MULTI_ACCEPTING) == TCP_STATE_MULTI_ACCEPTING) {
+ if ((state & INET_STATE_MULTI_ACCEPTING) == INET_STATE_MULTI_ACCEPTING) {
int id,req;
MultiTimerData *timeout;
if (remove_multi_op(desc, &id, &req, who, &timeout, NULL) != 0) {
@@ -8299,15 +8458,15 @@ static void tcp_inet_process_exit(ErlDrvData e, ErlDrvMonitor *monitorp)
}
if (desc->multi_first == NULL) {
sock_select(INETP(desc),FD_ACCEPT,0);
- desc->inet.state = TCP_STATE_LISTEN; /* restore state */
+ desc->inet.state = INET_STATE_LISTENING; /* restore state */
}
- } else if ((state & TCP_STATE_ACCEPTING) == TCP_STATE_ACCEPTING) {
+ } else if ((state & INET_STATE_ACCEPTING) == INET_STATE_ACCEPTING) {
int did,drid;
ErlDrvTermData dcaller;
deq_async(INETP(desc), &did, &dcaller, &drid);
driver_cancel_timer(desc->inet.port);
sock_select(INETP(desc),FD_ACCEPT,0);
- desc->inet.state = TCP_STATE_LISTEN; /* restore state */
+ desc->inet.state = INET_STATE_LISTENING; /* restore state */
}
}
@@ -8497,32 +8656,29 @@ static int tcp_deliver(tcp_descriptor* desc, int len)
}
while (len > 0) {
- int code = 0;
+ int code;
inet_input_count(INETP(desc), len);
/* deliver binary? */
if (len*4 >= desc->i_buf->orig_size*3) { /* >=75% */
+ code = tcp_reply_binary_data(desc, desc->i_buf,
+ (desc->i_ptr_start -
+ desc->i_buf->orig_bytes),
+ len);
+ if (code < 0)
+ return code;
+
/* something after? */
if (desc->i_ptr_start + len == desc->i_ptr) { /* no */
- code = tcp_reply_binary_data(desc, desc->i_buf,
- (desc->i_ptr_start -
- desc->i_buf->orig_bytes),
- len);
tcp_clear_input(desc);
}
else { /* move trail to beginning of a new buffer */
- ErlDrvBinary* bin;
+ ErlDrvBinary* bin = alloc_buffer(desc->i_bufsz);
char* ptr_end = desc->i_ptr_start + len;
int sz = desc->i_ptr - ptr_end;
- bin = alloc_buffer(desc->i_bufsz);
memcpy(bin->orig_bytes, ptr_end, sz);
-
- code = tcp_reply_binary_data(desc, desc->i_buf,
- (desc->i_ptr_start-
- desc->i_buf->orig_bytes),
- len);
free_buffer(desc->i_buf);
desc->i_buf = bin;
desc->i_ptr_start = desc->i_buf->orig_bytes;
@@ -8534,17 +8690,15 @@ static int tcp_deliver(tcp_descriptor* desc, int len)
code = tcp_reply_data(desc, desc->i_ptr_start, len);
/* XXX The buffer gets thrown away on error (code < 0) */
/* Windows needs workaround for this in tcp_inet_event... */
+ if (code < 0)
+ return code;
desc->i_ptr_start += len;
if (desc->i_ptr_start == desc->i_ptr)
tcp_clear_input(desc);
else
desc->i_remain = 0;
-
}
- if (code < 0)
- return code;
-
count++;
len = 0;
@@ -8849,8 +9003,8 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event)
/* socket has input:
-** 1. TCP_STATE_ACCEPTING => non block accept ?
-** 2. TCP_STATE_CONNECTED => read input
+** 1. INET_STATE_ACCEPTING => non block accept ?
+** 2. INET_STATE_CONNECTED => read input
*/
static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
{
@@ -8859,7 +9013,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
long port = (long) desc->inet.port; /* Used after driver_exit() */
#endif
DEBUGF(("tcp_inet_input(%ld) {s=%d\r\n", port, desc->inet.s));
- if (desc->inet.state == TCP_STATE_ACCEPTING) {
+ if (desc->inet.state == INET_STATE_ACCEPTING) {
SOCKET s;
unsigned int len;
inet_address remote;
@@ -8874,7 +9028,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
}
sock_select(INETP(desc),FD_ACCEPT,0);
- desc->inet.state = TCP_STATE_LISTEN; /* restore state */
+ desc->inet.state = INET_STATE_LISTENING; /* restore state */
if (this_op != NULL) {
driver_demonitor_process(desc->inet.port, &(this_op->monitor));
@@ -8914,11 +9068,11 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
driver_select(accept_desc->inet.port, accept_desc->inet.event,
ERL_DRV_READ, 1);
#endif
- accept_desc->inet.state = TCP_STATE_CONNECTED;
+ accept_desc->inet.state = INET_STATE_CONNECTED;
ret = async_ok_port(INETP(desc), accept_desc->inet.dport);
goto done;
}
- } else if (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) {
+ } else if (desc->inet.state == INET_STATE_MULTI_ACCEPTING) {
SOCKET s;
unsigned int len;
inet_address remote;
@@ -8930,7 +9084,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
int times = 0;
#endif
- while (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) {
+ while (desc->inet.state == INET_STATE_MULTI_ACCEPTING) {
len = sizeof(desc->inet.remote);
s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len);
@@ -8950,7 +9104,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
if (desc->multi_first == NULL) {
sock_select(INETP(desc),FD_ACCEPT,0);
- desc->inet.state = TCP_STATE_LISTEN; /* restore state */
+ desc->inet.state = INET_STATE_LISTENING; /* restore state */
}
if (timeout != NULL) {
@@ -8981,7 +9135,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
driver_select(accept_desc->inet.port, accept_desc->inet.event,
ERL_DRV_READ, 1);
#endif
- accept_desc->inet.state = TCP_STATE_CONNECTED;
+ accept_desc->inet.state = INET_STATE_CONNECTED;
ret = send_async_ok_port(desc->inet.port, desc->inet.dport,
id, caller, accept_desc->inet.dport);
}
@@ -9259,8 +9413,8 @@ static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event)
}
/* socket ready for ouput:
-** 1. TCP_STATE_CONNECTING => non block connect ?
-** 2. TCP_STATE_CONNECTED => write output
+** 1. INET_STATE_CONNECTING => non block connect ?
+** 2. INET_STATE_CONNECTED => write output
*/
static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
{
@@ -9269,7 +9423,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
DEBUGF(("tcp_inet_output(%ld) {s=%d\r\n",
(long)desc->inet.port, desc->inet.s));
- if (desc->inet.state == TCP_STATE_CONNECTING) {
+ if (desc->inet.state == INET_STATE_CONNECTING) {
sock_select(INETP(desc),FD_CONNECT,0);
driver_cancel_timer(ix); /* posssibly cancel a timer */
@@ -9289,7 +9443,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
(struct sockaddr*) &desc->inet.remote, &sz);
if (IS_SOCKET_ERROR(code)) {
- desc->inet.state = TCP_STATE_BOUND; /* restore state */
+ desc->inet.state = INET_STATE_BOUND; /* restore state */
ret = async_error(INETP(desc), sock_errno());
goto done;
}
@@ -9302,15 +9456,15 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
(void *)&error, &sz);
if ((code < 0) || error) {
- desc->inet.state = TCP_STATE_BOUND; /* restore state */
+ desc->inet.state = INET_STATE_BOUND; /* restore state */
ret = async_error(INETP(desc), error);
goto done;
}
}
-#endif /* SOCKOPT_CONNECT_STAT */
+#endif /* SO_ERROR */
#endif /* !__WIN32__ */
- desc->inet.state = TCP_STATE_CONNECTED;
+ desc->inet.state = INET_STATE_CONNECTED;
if (desc->inet.active)
sock_select(INETP(desc),(FD_READ|FD_CLOSE),1);
async_ok(INETP(desc));
@@ -9410,6 +9564,59 @@ static int should_use_so_bsdcompat(void)
#endif /* __linux__ */
#endif /* HAVE_SO_BSDCOMPAT */
+
+
+#ifdef HAVE_SCTP
+/* Copy a descriptor, by creating a new port with same settings
+ * as the descriptor desc.
+ * return NULL on error (ENFILE no ports avail)
+ */
+static udp_descriptor* sctp_inet_copy(udp_descriptor* desc, SOCKET s, int* err)
+{
+ ErlDrvPort port = desc->inet.port;
+ udp_descriptor* copy_desc;
+
+ copy_desc = (udp_descriptor*) sctp_inet_start(port, NULL);
+
+ /* Setup event if needed */
+ if ((copy_desc->inet.s = s) != INVALID_SOCKET) {
+ if ((copy_desc->inet.event = sock_create_event(INETP(copy_desc))) ==
+ INVALID_EVENT) {
+ *err = sock_errno();
+ FREE(copy_desc);
+ return NULL;
+ }
+ }
+
+ /* Some flags must be inherited at this point */
+ copy_desc->inet.mode = desc->inet.mode;
+ copy_desc->inet.exitf = desc->inet.exitf;
+ copy_desc->inet.bit8f = desc->inet.bit8f;
+ copy_desc->inet.deliver = desc->inet.deliver;
+ copy_desc->inet.htype = desc->inet.htype;
+ copy_desc->inet.psize = desc->inet.psize;
+ copy_desc->inet.stype = desc->inet.stype;
+ copy_desc->inet.sfamily = desc->inet.sfamily;
+ copy_desc->inet.hsz = desc->inet.hsz;
+ copy_desc->inet.bufsz = desc->inet.bufsz;
+
+ /* The new port will be linked and connected to the caller */
+ port = driver_create_port(port, desc->inet.caller, "sctp_inet",
+ (ErlDrvData) copy_desc);
+ if ((long)port == -1) {
+ *err = ENFILE;
+ FREE(copy_desc);
+ return NULL;
+ }
+ copy_desc->inet.port = port;
+ copy_desc->inet.dport = driver_mk_port(port);
+ *err = 0;
+ return copy_desc;
+}
+#endif
+
+
+
static int packet_inet_init()
{
return 0;
@@ -9428,6 +9635,9 @@ static ErlDrvData packet_inet_start(ErlDrvPort port, char* args, int protocol)
return ERL_DRV_ERROR_ERRNO;
desc->read_packets = INET_PACKET_POLL;
+ desc->i_bufsz = 0;
+ desc->i_buf = NULL;
+ desc->i_ptr = NULL;
return drvd;
}
@@ -9452,6 +9662,10 @@ static void packet_inet_stop(ErlDrvData e)
*/
udp_descriptor * udesc = (udp_descriptor*) e;
inet_descriptor* descr = INETP(udesc);
+ if (udesc->i_buf != NULL) {
+ release_buffer(udesc->i_buf);
+ udesc->i_buf = NULL;
+ }
ASSERT(NO_SUBSCRIBERS(&(descr->empty_out_q_subs)));
inet_stop(descr);
@@ -9476,21 +9690,31 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
udp_descriptor * udesc = (udp_descriptor *) e;
inet_descriptor* desc = INETP(udesc);
int type = SOCK_DGRAM;
- int af;
-#ifdef HAVE_SCTP
- if (IS_SCTP(desc)) type = SOCK_SEQPACKET;
-#endif
+ int af = AF_INET;
switch(cmd) {
case INET_REQ_OPEN: /* open socket and return internal index */
DEBUGF(("packet_inet_ctl(%ld): OPEN\r\n", (long)desc->port));
- if (len != 1) {
+ if (len != 2) {
return ctl_error(EINVAL, rbuf, rsize);
}
switch (buf[0]) {
case INET_AF_INET: af = AF_INET; break;
#if defined(HAVE_IN6) && defined(AF_INET6)
- case INET_AF_INET6: af = AF_INET6; break;
+ case INET_AF_INET6: af = AF_INET6; break;
+#else
+ case INET_AF_INET6:
+ return ctl_xerror("eafnosupport", rbuf, rsize);
+ break;
+#endif
+ default:
+ return ctl_error(EINVAL, rbuf, rsize);
+ }
+ switch (buf[1]) {
+ case INET_TYPE_STREAM: type = SOCK_STREAM; break;
+ case INET_TYPE_DGRAM: type = SOCK_DGRAM; break;
+#ifdef HAVE_SCTP
+ case INET_TYPE_SEQPACKET: type = SOCK_SEQPACKET; break;
#endif
default:
return ctl_error(EINVAL, rbuf, rsize);
@@ -9517,18 +9741,35 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
return replen;
- case INET_REQ_FDOPEN: /* pass in an open (and bound) socket */
+ case INET_REQ_FDOPEN: { /* pass in an open (and bound) socket */
+ SOCKET s;
DEBUGF(("packet inet_ctl(%ld): FDOPEN\r\n", (long)desc->port));
- if ((len == 5) && (buf[0] == INET_AF_INET))
- replen = inet_ctl_fdopen(desc, AF_INET, SOCK_DGRAM,
- (SOCKET)get_int32(buf+1),rbuf,rsize);
+ if (len != 6) {
+ return ctl_error(EINVAL, rbuf, rsize);
+ }
+ switch (buf[0]) {
+ case INET_AF_INET: af = AF_INET; break;
#if defined(HAVE_IN6) && defined(AF_INET6)
- else if ((len == 5) && (buf[0] == INET_AF_INET6))
- replen = inet_ctl_fdopen(desc, AF_INET6, SOCK_DGRAM,
- (SOCKET)get_int32(buf+1),rbuf,rsize);
+ case INET_AF_INET6: af = AF_INET6; break;
+#else
+ case INET_AF_INET6:
+ return ctl_xerror("eafnosupport", rbuf, rsize);
+ break;
#endif
- else
+ default:
return ctl_error(EINVAL, rbuf, rsize);
+ }
+ switch (buf[1]) {
+ case INET_TYPE_STREAM: type = SOCK_STREAM; break;
+ case INET_TYPE_DGRAM: type = SOCK_DGRAM; break;
+#ifdef HAVE_SCTP
+ case INET_TYPE_SEQPACKET: type = SOCK_SEQPACKET; break;
+#endif
+ default:
+ return ctl_error(EINVAL, rbuf, rsize);
+ }
+ s = (SOCKET)get_int32(buf+2);
+ replen = inet_ctl_fdopen(desc, af, type, s, rbuf, rsize);
if ((*rbuf)[0] != INET_REP_ERROR) {
if (desc->active)
@@ -9548,6 +9789,7 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
#endif
}
return replen;
+ }
case INET_REQ_CLOSE:
@@ -9567,8 +9809,9 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
*/
int code;
char tbuf[2];
+#ifdef HAVE_SCTP
unsigned timeout;
-
+#endif
DEBUGF(("packet_inet_ctl(%ld): CONNECT\r\n", (long)desc->port));
/* INPUT: [ Timeout(4), Port(2), Address(N) ] */
@@ -9600,14 +9843,14 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
if (IS_SOCKET_ERROR(code) && (sock_errno() == EINPROGRESS)) {
/* XXX: Unix only -- WinSock would have a different cond! */
- desc->state = SCTP_STATE_CONNECTING;
+ desc->state = INET_STATE_CONNECTING;
if (timeout != INET_INFINITY)
driver_set_timer(desc->port, timeout);
enq_async(desc, tbuf, INET_REQ_CONNECT);
}
else if (code == 0) { /* OK we are connected */
sock_select(desc, FD_CONNECT, 0);
- desc->state = PACKET_STATE_CONNECTED;
+ desc->state = INET_STATE_CONNECTED;
enq_async(desc, tbuf, INET_REQ_CONNECT);
async_ok(desc);
}
@@ -9629,7 +9872,7 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
else if (len < 6)
return ctl_error(EINVAL, rbuf, rsize);
else {
- timeout = get_int32(buf); /* IGNORED */
+ /* Ignore timeout */
buf += 4;
len -= 4;
if (inet_set_address(desc->sfamily,
@@ -9653,11 +9896,11 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
}
#ifdef HAVE_SCTP
- case SCTP_REQ_LISTEN:
+ case INET_REQ_LISTEN:
{ /* LISTEN is only for SCTP sockets, not UDP. This code is borrowed
from the TCP section. Returns: {ok,[]} on success.
*/
- int flag;
+ int backlog;
DEBUGF(("packet_inet_ctl(%ld): LISTEN\r\n", (long)desc->port));
if (!IS_SCTP(desc))
@@ -9667,15 +9910,14 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
if (!IS_BOUND(desc))
return ctl_xerror(EXBADSEQ, rbuf, rsize);
- /* The arg is a binary value: 1:enable, 0:disable */
- if (len != 1)
+ if (len != 2)
return ctl_error(EINVAL, rbuf, rsize);
- flag = get_int8(buf);
+ backlog = get_int16(buf);
- if (IS_SOCKET_ERROR(sock_listen(desc->s, flag)))
+ if (IS_SOCKET_ERROR(sock_listen(desc->s, backlog)))
return ctl_error(sock_errno(), rbuf, rsize);
- desc->state = SCTP_STATE_LISTEN; /* XXX: not used? */
+ desc->state = INET_STATE_LISTENING; /* XXX: not used? */
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
@@ -9721,6 +9963,46 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
}
+
+ case SCTP_REQ_PEELOFF:
+ {
+ Uint32 assoc_id;
+ udp_descriptor* new_udesc;
+ int err;
+ SOCKET new_socket;
+
+ DEBUGF(("packet_inet_ctl(%ld): PEELOFF\r\n", (long)desc->port));
+ if (!IS_SCTP(desc))
+ return ctl_xerror(EXBADPORT, rbuf, rsize);
+ if (!IS_OPEN(desc))
+ return ctl_xerror(EXBADPORT, rbuf, rsize);
+ if (!IS_BOUND(desc))
+ return ctl_xerror(EXBADSEQ, rbuf, rsize);
+ if (! p_sctp_peeloff)
+ return ctl_error(ENOTSUP, rbuf, rsize);
+
+ if (len != 4)
+ return ctl_error(EINVAL, rbuf, rsize);
+ assoc_id = get_int32(buf);
+
+ new_socket = p_sctp_peeloff(desc->s, assoc_id);
+ if (IS_SOCKET_ERROR(new_socket)) {
+ return ctl_error(sock_errno(), rbuf, rsize);
+ }
+
+ desc->caller = driver_caller(desc->port);
+ if ((new_udesc = sctp_inet_copy(udesc, new_socket, &err)) == NULL) {
+ sock_close(new_socket);
+ desc->caller = 0;
+ return ctl_error(err, rbuf, rsize);
+ }
+ new_udesc->inet.state = INET_STATE_CONNECTED;
+ new_udesc->inet.stype = SOCK_STREAM;
+
+ inet_reply_ok_port(desc, new_udesc->inet.dport);
+ (*rbuf)[0] = INET_REP;
+ return 1;
+ }
#endif /* HAVE_SCTP */
case PACKET_REQ_RECV:
@@ -9919,12 +10201,8 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
{
inet_descriptor* desc = INETP(udesc);
int n;
- unsigned int len;
inet_address other;
char abuf[sizeof(inet_address)]; /* buffer address; enough??? */
- int sz;
- char* ptr;
- ErlDrvBinary* buf; /* binary */
int packet_count = udesc->read_packets;
int count = 0; /* number of packets delivered to owner */
#ifdef HAVE_SCTP
@@ -9935,23 +10213,39 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
#endif
while(packet_count--) {
- len = sizeof(other);
- sz = desc->bufsz;
- /* Allocate space for message and address. NB: "bufsz" is in "desc",
- but the "buf" itself is allocated separately:
- */
- if ((buf = alloc_buffer(sz+len)) == NULL)
- return packet_error(udesc, ENOMEM);
- ptr = buf->orig_bytes + len; /* pointer to message part */
+ unsigned int len = sizeof(other);
+
+ /* udesc->i_buf is only kept between SCTP fragments */
+ if (udesc->i_buf == NULL) {
+ udesc->i_bufsz = desc->bufsz + len;
+ if ((udesc->i_buf = alloc_buffer(udesc->i_bufsz)) == NULL)
+ return packet_error(udesc, ENOMEM);
+ /* pointer to message start */
+ udesc->i_ptr = udesc->i_buf->orig_bytes + len;
+ } else {
+ ErlDrvBinary* tmp;
+ int bufsz;
+ bufsz = desc->bufsz + (udesc->i_ptr - udesc->i_buf->orig_bytes);
+ if ((tmp = realloc_buffer(udesc->i_buf, bufsz)) == NULL) {
+ release_buffer(udesc->i_buf);
+ udesc->i_buf = NULL;
+ return packet_error(udesc, ENOMEM);
+ } else {
+ udesc->i_ptr =
+ tmp->orig_bytes + (udesc->i_ptr - udesc->i_buf->orig_bytes);
+ udesc->i_buf = tmp;
+ udesc->i_bufsz = bufsz;
+ }
+ }
/* Note: On Windows NT, recvfrom() fails if the socket is connected. */
#ifdef HAVE_SCTP
/* For SCTP we must use recvmsg() */
if (IS_SCTP(desc)) {
- iov->iov_base = ptr; /* Data will come here */
- iov->iov_len = sz; /* Remaining buffer space */
+ iov->iov_base = udesc->i_ptr; /* Data will come here */
+ iov->iov_len = desc->bufsz; /* Remaining buffer space */
- mhdr.msg_name = &other; /* Peer addr comes into "other" */
+ mhdr.msg_name = &other; /* Peer addr comes into "other" */
mhdr.msg_namelen = len;
mhdr.msg_iov = iov;
mhdr.msg_iovlen = 1;
@@ -9961,42 +10255,28 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
/* Do the actual SCTP receive: */
n = sock_recvmsg(desc->s, &mhdr, 0);
+ len = mhdr.msg_namelen;
goto check_result;
}
#endif
/* Use recv() instead on connected sockets. */
if ((desc->state & INET_F_ACTIVE)) {
- n = sock_recv(desc->s, ptr, sz, 0);
+ n = sock_recv(desc->s, udesc->i_ptr, desc->bufsz, 0);
other = desc->remote;
+ goto check_result;
}
- else
- n = sock_recvfrom(desc->s, ptr, sz, 0, &other.sa, &len);
-
-#ifdef HAVE_SCTP
+ n = sock_recvfrom(desc->s, udesc->i_ptr, desc->bufsz,
+ 0, &other.sa, &len);
check_result:
-#endif
/* Analyse the result: */
- if (IS_SOCKET_ERROR(n)
-#ifdef HAVE_SCTP
- || (short_recv = (IS_SCTP(desc) && !(mhdr.msg_flags & MSG_EOR)))
- /* NB: here we check for EOR not being set -- this is an error as
- well, we don't support partial msgs:
- */
-#endif
- ) {
+ if (IS_SOCKET_ERROR(n)) {
int err = sock_errno();
- release_buffer(buf);
if (err != ERRNO_BLOCK) {
+ /* real error */
+ release_buffer(udesc->i_buf);
+ udesc->i_buf = NULL;
if (!desc->active) {
-#ifdef HAVE_SCTP
- if (short_recv) {
- async_error_am(desc, am_short_recv);
- } else {
- async_error(desc, err);
- }
-#else
async_error(desc, err);
-#endif
driver_cancel_timer(desc->port);
sock_select(desc,FD_READ,0);
}
@@ -10004,46 +10284,72 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
/* This is for an active desc only: */
packet_error_message(udesc, err);
}
+ return count;
}
- else if (!desc->active)
+ /* would block error - try again */
+ if (!desc->active
+#ifdef HAVE_SCTP
+ || short_recv
+#endif
+ ) {
sock_select(desc,FD_READ,1);
+ }
return count; /* strange, not ready */
}
- else {
- int offs;
- int nsz;
+
+#ifdef HAVE_SCTP
+ if (IS_SCTP(desc) && (short_recv = !(mhdr.msg_flags & MSG_EOR))) {
+ /* SCTP non-final message fragment */
+ inet_input_count(desc, n);
+ udesc->i_ptr += n;
+ continue; /* wait for more fragments */
+ }
+#endif
+
+ {
+ /* message received */
int code;
- unsigned int alen = len;
void * extra = NULL;
+ char * ptr;
+ int nsz;
inet_input_count(desc, n);
- inet_get_address(desc->sfamily, abuf, &other, &alen);
- /* Copy formatted address to the buffer allocated; "alen" is the
- actual length which must be <= than the original reserved "len".
+ udesc->i_ptr += n;
+ inet_get_address(desc->sfamily, abuf, &other, &len);
+ /* Copy formatted address to the buffer allocated; "len" is the
+ actual length which must be <= than the original reserved.
This means that the addr + data in the buffer are contiguous,
- but they may start not at the "orig_bytes", but with some "offs"
- from them:
+ but they may start not at the "orig_bytes", instead at "ptr":
*/
- ASSERT (alen <= len);
- sys_memcpy(ptr - alen, abuf, alen);
- ptr -= alen;
- nsz = n + alen; /* nsz = data + address */
- offs = ptr - buf->orig_bytes; /* initial pointer offset */
+ ASSERT (len <= sizeof(other));
+ ptr = udesc->i_buf->orig_bytes + sizeof(other) - len;
+ sys_memcpy(ptr, abuf, len);
+
+ nsz = udesc->i_ptr - ptr;
/* Check if we need to reallocate binary */
- if ((desc->mode == INET_MODE_BINARY) &&
- (desc->hsz < n) && (nsz < BIN_REALLOC_LIMIT(sz))) {
+ if ((desc->mode == INET_MODE_BINARY)
+ && (desc->hsz < (nsz - len))
+ && (nsz + BIN_REALLOC_MARGIN(desc->bufsz) < udesc->i_bufsz)) {
ErlDrvBinary* tmp;
- if ((tmp = realloc_buffer(buf,nsz+offs)) != NULL)
- buf = tmp;
+ int bufsz;
+ bufsz = udesc->i_ptr - udesc->i_buf->orig_bytes;
+ if ((tmp = realloc_buffer(udesc->i_buf, bufsz)) != NULL) {
+ udesc->i_buf = tmp;
+ udesc->i_bufsz = bufsz;
+ udesc->i_ptr = NULL; /* not used from here */
+ }
}
#ifdef HAVE_SCTP
if (IS_SCTP(desc)) extra = &mhdr;
#endif
/* Actual parsing and return of the data received, occur here: */
- code = packet_reply_binary_data(desc, (unsigned int)alen,
- buf, offs, nsz, extra);
- free_buffer(buf);
+ code = packet_reply_binary_data(desc, len, udesc->i_buf,
+ (sizeof(other) - len),
+ nsz,
+ extra);
+ free_buffer(udesc->i_buf);
+ udesc->i_buf = NULL;
if (code < 0)
return count;
count++;
@@ -10053,7 +10359,17 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
return count; /* passive mode (read one packet only) */
}
}
+ } /* while(packet_count--) { */
+
+ /* we ran out of tries (packet_count) either on an active socket
+ * that got that many messages or an SCTP socket that got that
+ * many message fragments but still not the final
+ */
+#ifdef HAVE_SCTP
+ if (short_recv) {
+ sock_select(desc, FD_READ, 1);
}
+#endif
return count;
}
@@ -10063,7 +10379,7 @@ static void packet_inet_drv_output(ErlDrvData e, ErlDrvEvent event)
}
/* UDP/SCTP socket ready for output:
-** This is a Back-End for Non-Block SCTP Connect (SCTP_STATE_CONNECTING)
+** This is a Back-End for Non-Block SCTP Connect (INET_STATE_CONNECTING)
*/
static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
{
@@ -10074,7 +10390,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
DEBUGF(("packet_inet_output(%ld) {s=%d\r\n",
(long)desc->port, desc->s));
- if (desc->state == SCTP_STATE_CONNECTING) {
+ if (desc->state == INET_STATE_CONNECTING) {
sock_select(desc, FD_CONNECT, 0);
driver_cancel_timer(ix); /* posssibly cancel a timer */
@@ -10094,7 +10410,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
(struct sockaddr*) &desc->remote, &sz);
if (IS_SOCKET_ERROR(code)) {
- desc->state = PACKET_STATE_BOUND; /* restore state */
+ desc->state = INET_STATE_BOUND; /* restore state */
ret = async_error(desc, sock_errno());
goto done;
}
@@ -10107,15 +10423,15 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
(void *)&error, &sz);
if ((code < 0) || error) {
- desc->state = PACKET_STATE_BOUND; /* restore state */
+ desc->state = INET_STATE_BOUND; /* restore state */
ret = async_error(desc, error);
goto done;
}
}
-#endif /* SOCKOPT_CONNECT_STAT */
+#endif /* SO_ERROR */
#endif /* !__WIN32__ */
- desc->state = PACKET_STATE_CONNECTED;
+ desc->state = INET_STATE_CONNECTED;
async_ok(desc);
}
else {
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index d782b044a9..45d39a559f 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -242,7 +242,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
#ifndef HAVE_TERMCAP
return ERL_DRV_ERROR_GENERAL;
#else
- char *s, *t, c, *l;
+ char *s, *t, *l;
int canon, echo, sig; /* Terminal characteristics */
int flag;
extern int using_oldshell; /* set this to let the rest of erts know */
@@ -262,7 +262,6 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
s++;
/* Find end of this argument (start of next) and insert NUL. */
if ((t = strchr(s, ' '))) {
- c = *t;
*t = '\0';
}
if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) {
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
index 931bb196f1..931bb196f1 100755..100644
--- a/erts/emulator/drivers/win32/win_efile.c
+++ b/erts/emulator/drivers/win32/win_efile.c
diff --git a/erts/emulator/hipe/hipe_abi.txt b/erts/emulator/hipe/hipe_abi.txt
index d0ec162342..9d4726de9d 100644
--- a/erts/emulator/hipe/hipe_abi.txt
+++ b/erts/emulator/hipe/hipe_abi.txt
@@ -62,7 +62,7 @@ exceptional condition, it puts an error code in p->freason
and returns THE_NON_VALUE (zero, except in debug mode).
If p->freason == TRAP, then the BIF redirects its call to some
-other function, given by p->def_arg_reg[].
+other function, given by p->i
The BIF and the new callee may have different arities.
The "hipe_${ARCH}_bifs.m4" macro files take care of these issues
diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4
index 0ba763cbea..ec25c0b9b7 100644
--- a/erts/emulator/hipe/hipe_amd64_bifs.m4
+++ b/erts/emulator/hipe/hipe_amd64_bifs.m4
@@ -20,24 +20,37 @@ changecom(`/*', `*/')dnl
include(`hipe/hipe_amd64_asm.m4')
+#`include' "config.h"
#`include' "hipe_literals.h"
+
`#if THE_NON_VALUE == 0
#define TEST_GOT_EXN testq %rax, %rax
#else
#define TEST_GOT_EXN cmpq $THE_NON_VALUE, %rax
#endif'
-`#define TEST_GOT_MBUF movq P_MBUF(P), %rdx; testq %rdx, %rdx; jnz 3f; 2:
-#define JOIN3(A,B,C) A##B##C
-#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b'
+define(TEST_GOT_MBUF,`movq P_MBUF(P), %rdx # `TEST_GOT_MBUF'
+ testq %rdx, %rdx
+ jnz 3f
+2:')
+define(HANDLE_GOT_MBUF,`
+3: call nbif_$1_gc_after_bif # `HANDLE_GOT_MBUF'
+ jmp 2b')
+
+`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+# define CALL_BIF(F) movq $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper)
+#else
+# define CALL_BIF(F) call CSYM(F)
+#endif'
/*
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 1-3 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -54,7 +67,11 @@ ASYM($1):
/* make the call on the C stack */
SWITCH_ERLANG_TO_C
- call CSYM($2)
+ pushq %rsi
+ movq %rsp, %rsi /* Eterm* BIF__ARGS */
+ sub $(8), %rsp /* stack frame 16-byte alignment */
+ CALL_BIF($2)
+ add $(1*8 + 8), %rsp
TEST_GOT_MBUF
SWITCH_C_TO_ERLANG
@@ -82,7 +99,11 @@ ASYM($1):
/* make the call on the C stack */
SWITCH_ERLANG_TO_C
- call CSYM($2)
+ pushq %rdx
+ pushq %rsi
+ movq %rsp, %rsi /* Eterm* BIF__ARGS */
+ CALL_BIF($2)
+ add $(2*8), %rsp
TEST_GOT_MBUF
SWITCH_C_TO_ERLANG
@@ -111,7 +132,13 @@ ASYM($1):
/* make the call on the C stack */
SWITCH_ERLANG_TO_C
- call CSYM($2)
+ pushq %rcx
+ pushq %rdx
+ pushq %rsi
+ movq %rsp, %rsi /* Eterm* BIF__ARGS */
+ sub $(8), %rsp /* stack frame 16-byte alignment */
+ CALL_BIF($2)
+ add $(3*8 + 8), %rsp
TEST_GOT_MBUF
SWITCH_C_TO_ERLANG
@@ -124,13 +151,7 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
-/*
- * fail_bif_interface_0(nbif_name, cbif_name)
- *
- * Generate native interface for a BIF with 0 parameters and
- * standard failure mode.
- */
-define(fail_bif_interface_0,
+define(standard_bif_interface_0,
`
#ifndef HAVE_$1
#`define' HAVE_$1
@@ -143,7 +164,7 @@ ASYM($1):
/* make the call on the C stack */
SWITCH_ERLANG_TO_C
- call CSYM($2)
+ CALL_BIF($2)
TEST_GOT_MBUF
SWITCH_C_TO_ERLANG
@@ -528,7 +549,9 @@ ASYM($1):
/*
* AMD64-specific primops.
*/
+#ifndef NO_FPE_SIGNALS
noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu)
+#endif /* NO_FPE_SIGNALS */
/*
* Implement gc_bif_interface_0 as nofail_primop_interface_0.
diff --git a/erts/emulator/hipe/hipe_amd64_primops.h b/erts/emulator/hipe/hipe_amd64_primops.h
index e3c7111997..55cb0eadb8 100644
--- a/erts/emulator/hipe/hipe_amd64_primops.h
+++ b/erts/emulator/hipe/hipe_amd64_primops.h
@@ -19,5 +19,7 @@
PRIMOP_LIST(am_inc_stack_0, &nbif_inc_stack_0)
+#ifndef NO_FPE_SIGNALS
PRIMOP_LIST(am_handle_fp_exception, &nbif_handle_fp_exception)
+#endif
PRIMOP_LIST(am_sse2_fnegate_mask, &sse2_fnegate_mask)
diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4
index 3664fb6502..e0c6f09796 100644
--- a/erts/emulator/hipe/hipe_arm_bifs.m4
+++ b/erts/emulator/hipe/hipe_arm_bifs.m4
@@ -20,18 +20,27 @@ changecom(`/*', `*/')dnl
include(`hipe/hipe_arm_asm.m4')
+#`include' "config.h"
#`include' "hipe_literals.h"
.text
.p2align 2
-`#define JOIN3(A,B,C) A##B##C
-#define TEST_GOT_MBUF(ARITY) ldr r1, [P, #P_MBUF]; cmp r1, #0; blne JOIN3(nbif_,ARITY,_gc_after_bif)'
+`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+# define CALL_BIF(F) mov r14, #F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper
+#else
+# define CALL_BIF(F) bl F
+#endif'
+
+define(TEST_GOT_MBUF,`ldr r1, [P, #P_MBUF] /* `TEST_GOT_MBUF' */
+ cmp r1, #0
+ blne nbif_$1_gc_after_bif')
/*
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_0(nbif_name, cbif_name)
*
* Generate native interface for a BIF with 1-3 parameters and
* standard failure mode.
@@ -48,7 +57,9 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl $2
+ str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */
+ add r1, r0, #P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF(1)
/* Restore registers. Check for exception. */
@@ -73,7 +84,10 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl $2
+ str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */
+ str r2, [r0, #P_ARG1]
+ add r1, r0, #P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF(2)
/* Restore registers. Check for exception. */
@@ -99,7 +113,11 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl $2
+ str r1, [r0, #P_ARG0] /* Store BIF__ARGS in def_arg_reg[] */
+ str r2, [r0, #P_ARG1]
+ str r3, [r0, #P_ARG2]
+ add r1, r0, #P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF(3)
/* Restore registers. Check for exception. */
@@ -111,13 +129,7 @@ $1:
.type $1, %function
#endif')
-/*
- * fail_bif_interface_0(nbif_name, cbif_name)
- *
- * Generate native interface for a BIF with 0 parameters and
- * standard failure mode.
- */
-define(fail_bif_interface_0,
+define(standard_bif_interface_0,
`
#ifndef HAVE_$1
#`define' HAVE_$1
@@ -128,7 +140,8 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl $2
+ /* ignore empty BIF__ARGS */
+ CALL_BIF($2)
TEST_GOT_MBUF(0)
/* Restore registers. Check for exception. */
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index e7fb850530..cec22b3836 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -985,6 +985,26 @@ BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1)
BIF_RET(res);
}
+#ifdef NO_FPE_SIGNALS
+
+/*
+ This is the current solution to make hipe run without FPE.
+ The native code is the same except that a call to this primop
+ is made after _every_ float operation to check the result.
+ The native fcheckerror still done later will detect if an
+ "emulated" FPE has occured.
+ We use p->hipe.float_result to avoid passing a 'double' argument,
+ which has its own calling convention (on amd64 at least).
+ Simple and slow...
+*/
+void hipe_emulate_fpe(Process* p)
+{
+ if (!finite(p->hipe.float_result)) {
+ p->fp_exception = 1;
+ }
+}
+#endif
+
#if 0 /* XXX: unused */
/*
* At least parts of this should be inlined in native code.
diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h
index f02e8862dc..c512d66f9d 100644
--- a/erts/emulator/hipe/hipe_bif0.h
+++ b/erts/emulator/hipe/hipe_bif0.h
@@ -29,7 +29,7 @@ extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa);
extern void hipe_mfa_info_table_init(void);
extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a);
-extern Eterm hipe_find_na_or_make_stub(Process*, Eterm, Eterm, Eterm);
+extern BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3);
extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a);
#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__)
extern void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int a);
diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab
index b6c6bede23..ce641365e9 100644
--- a/erts/emulator/hipe/hipe_bif0.tab
+++ b/erts/emulator/hipe/hipe_bif0.tab
@@ -140,3 +140,5 @@ atom bs_put_utf16le
atom bs_get_utf16
atom bs_validate_unicode
atom bs_validate_unicode_retract
+atom emulate_fpe
+
diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c
index 2660f74a82..ee97541e15 100644
--- a/erts/emulator/hipe/hipe_bif2.c
+++ b/erts/emulator/hipe/hipe_bif2.c
@@ -166,3 +166,26 @@ BIF_RETTYPE hipe_bifs_show_message_area_0(BIF_ALIST_0)
BIF_RET(am_false);
#endif
}
+
+#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+
+BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1);
+
+# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
+ if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN)
+# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
+
+BIF_RETTYPE hipe_debug_bif_wrapper(BIF_ALIST_1)
+{
+ typedef BIF_RETTYPE Bif(BIF_ALIST_1);
+ Bif* fp = (Bif*) (BIF_P->hipe.bif_callee);
+ BIF_RETTYPE res;
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(BIF_P);
+ res = (*fp)(BIF_P, BIF__ARGS);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(BIF_P);
+ return res;
+}
+
+#endif /* ERTS_ENABLE_LOCK_CHECK && ERTS_SMP */
+
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 9780437847..942fa0c5cb 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -70,24 +70,18 @@
****************************************************************/
/*
+ * standard_bif_interface_0(nbif_name, cbif_name)
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
*
- * A BIF with implicit P parameter, 1-3 ordinary parameters,
+ * A BIF with implicit P parameter, 0-3 ordinary parameters,
* which may fail.
* HP and FCALLS may be read and updated.
* HP_LIMIT, NSP, NSP_LIMIT, and NRA may not be accessed.
*/
/*
- * fail_bif_interface_0(nbif_name, cbif_name)
- *
- * A zero-arity BIF which may fail, otherwise
- * identical to standard_bif_interface_N.
- */
-
-/*
* nofail_primop_interface_0(nbif_name, cbif_name)
* nofail_primop_interface_1(nbif_name, cbif_name)
* nofail_primop_interface_2(nbif_name, cbif_name)
@@ -150,7 +144,7 @@
/*
* Zero-arity BIFs that can fail.
*/
-fail_bif_interface_0(nbif_processes_0, processes_0)
+standard_bif_interface_0(nbif_processes_0, processes_0)
/*
* BIFs and primops that may do a GC (change heap limit and walk the native stack).
@@ -175,10 +169,10 @@ gc_bif_interface_0(nbif_hipe_bifs_nstack_used_size_0, hipe_bifs_nstack_used_size
/*
* Arithmetic operators called indirectly by the HiPE compiler.
*/
-standard_bif_interface_2(nbif_add_2, erts_mixed_plus)
-standard_bif_interface_2(nbif_sub_2, erts_mixed_minus)
-standard_bif_interface_2(nbif_mul_2, erts_mixed_times)
-standard_bif_interface_2(nbif_div_2, erts_mixed_div)
+standard_bif_interface_2(nbif_add_2, splus_2)
+standard_bif_interface_2(nbif_sub_2, sminus_2)
+standard_bif_interface_2(nbif_mul_2, stimes_2)
+standard_bif_interface_2(nbif_div_2, div_2)
standard_bif_interface_2(nbif_intdiv_2, intdiv_2)
standard_bif_interface_2(nbif_rem_2, rem_2)
standard_bif_interface_2(nbif_bsl_2, bsl_2)
@@ -251,6 +245,10 @@ noproc_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer)
gc_bif_interface_0(nbif_check_get_msg, hipe_check_get_msg)
+#ifdef NO_FPE_SIGNALS
+nocons_nofail_primop_interface_0(nbif_emulate_fpe, hipe_emulate_fpe)
+#endif
+
/*
* SMP-specific stuff
*/
@@ -260,11 +258,6 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc)
',)dnl
/*
- * Implement standard_bif_interface_0 as nofail_primop_interface_0.
- */
-define(standard_bif_interface_0,`nofail_primop_interface_0($1, $2)')
-
-/*
* Standard BIFs.
* BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index)
*/
diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c
index bced90785d..d07d14028c 100644
--- a/erts/emulator/hipe/hipe_mkliterals.c
+++ b/erts/emulator/hipe/hipe_mkliterals.c
@@ -1,9 +1,8 @@
/*
* %CopyrightBegin%
-
- *
+ *
* Copyright Ericsson AB 2001-2011. All Rights Reserved.
- *
+ *
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
* compliance with the License. You should have received a copy of the
@@ -212,6 +211,11 @@ static const unsigned int CRCTABLE[256] = {
0xB40BBE37, 0xC30C8EA1, 0x5A05DF1B, 0x2D02EF8D,
};
+/* For hipe cross compiler. Hard code all values.
+ No calls by hipe compiler to query the running emulator.
+*/
+static int is_xcomp = 0;
+
/*
* The algorithm for calculating the 32 bit CRC checksum is based upon
* documentation and algorithms provided by Dr. Ross N. Williams in the
@@ -243,7 +247,7 @@ crc_update_buf(unsigned int crc_value,
}
static unsigned int
-crc_update_int(unsigned int crc_value, const unsigned int *p)
+crc_update_int(unsigned int crc_value, const int *p)
{
return crc_update_buf(crc_value, p, sizeof *p);
}
@@ -256,7 +260,7 @@ crc_update_int(unsigned int crc_value, const unsigned int *p)
*/
static const struct literal {
const char *name;
- unsigned int value;
+ int value;
} literals[] = {
/* Field offsets in a process struct */
{ "P_HP", offsetof(struct process, htop) },
@@ -289,6 +293,14 @@ static const struct literal {
{ "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 */
@@ -298,7 +310,7 @@ static const struct literal {
{ "FREASON_TRAP", TRAP },
/* special Erlang constants */
- { "THE_NON_VALUE", THE_NON_VALUE },
+ { "THE_NON_VALUE", (int)THE_NON_VALUE },
/* funs */
#ifdef HIPE
@@ -452,7 +464,7 @@ static const struct rts_param {
unsigned int nr;
const char *name;
unsigned int is_defined;
- unsigned int value;
+ int value;
} rts_params[] = {
{ 1, "P_OFF_HEAP_FUNS",
#if !defined(HYBRID)
@@ -484,7 +496,7 @@ static const struct rts_param {
#endif
},
{ 14, "P_FP_EXCEPTION",
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
1, offsetof(struct process, fp_exception)
#endif
},
@@ -497,6 +509,15 @@ static const struct rts_param {
0
#endif
},
+ /* This flag is always defined, but its value is configuration-dependent. */
+ { 16, "ERTS_NO_FPE_SIGNALS",
+ 1,
+#if defined(NO_FPE_SIGNALS)
+ 1
+#else
+ 0
+#endif
+ },
/* This parameter is always defined, but its value depends on ERTS_SMP. */
{ 19, "MSG_MESSAGE",
1, offsetof(struct erl_mesg, m[0])
@@ -528,12 +549,12 @@ static void compute_crc(void)
static void c_define_literal(FILE *fp, const struct literal *literal)
{
- fprintf(fp, "#define %s %u\n", literal->name, literal->value);
+ fprintf(fp, "#define %s %d\n", literal->name, literal->value);
}
static void e_define_literal(FILE *fp, const struct literal *literal)
{
- fprintf(fp, "-define(%s, %u).\n", literal->name, literal->value);
+ fprintf(fp, "-define(%s, %d).\n", literal->name, literal->value);
}
static void print_literals(FILE *fp, void (*print_literal)(FILE*, const struct literal*))
@@ -560,7 +581,7 @@ static void print_atom_literals(FILE *fp, void (*print_atom_literal)(FILE*, cons
static void c_define_param(FILE *fp, const struct rts_param *param)
{
if (param->is_defined)
- fprintf(fp, "#define %s %u\n", param->name, param->value);
+ fprintf(fp, "#define %s %d\n", param->name, param->value);
}
static void c_case_param(FILE *fp, const struct rts_param *param)
@@ -568,7 +589,7 @@ static void c_case_param(FILE *fp, const struct rts_param *param)
fprintf(fp, " \\\n");
fprintf(fp, "\tcase %u: ", param->nr);
if (param->is_defined)
- fprintf(fp, "value = %u", param->value);
+ fprintf(fp, "value = %d", param->value);
else
fprintf(fp, "is_defined = 0");
fprintf(fp, "; break;");
@@ -576,7 +597,15 @@ static void c_case_param(FILE *fp, const struct rts_param *param)
static void e_define_param(FILE *fp, const struct rts_param *param)
{
- fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr);
+ if (is_xcomp) {
+ if (param->is_defined)
+ fprintf(fp, "-define(%s, %d).\n", param->name, param->value);
+ else
+ fprintf(fp, "-define(%s, []).\n", param->name);
+ }
+ else {
+ fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr);
+ }
}
static void print_params(FILE *fp, void (*print_param)(FILE*,const struct rts_param*))
@@ -613,19 +642,40 @@ static int do_e(FILE *fp, const char* this_exe)
fprintf(fp, "\n");
print_params(fp, e_define_param);
fprintf(fp, "\n");
- fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", literals_crc);
+ if (is_xcomp) {
+ fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc);
+ }
+ else {
+ fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n",
+ literals_crc);
+ }
return 0;
}
int main(int argc, const char **argv)
{
+ int i;
+ int (*do_func_ptr)(FILE *, const char*) = NULL;
+
compute_crc();
- if (argc == 2) {
- if (strcmp(argv[1], "-c") == 0)
- return do_c(stdout, argv[0]);
- if (strcmp(argv[1], "-e") == 0)
- return do_e(stdout, argv[0]);
+ for (i = 1; i < argc; i++) {
+ if (strcmp(argv[i], "-c") == 0)
+ do_func_ptr = &do_c;
+ else if (strcmp(argv[i], "-e") == 0)
+ do_func_ptr = &do_e;
+ else if (strcmp(argv[i], "-x") == 0)
+ is_xcomp = 1;
+ else
+ goto error;
+ }
+ if (do_func_ptr) {
+ return do_func_ptr(stdout, argv[0]);
}
- fprintf(stderr, "usage: %s [-c | -e] > output-file\n", argv[0]);
+error:
+ fprintf(stderr, "usage: %s [-x] [-c | -e] > output-file\n"
+ "\t-c\tC header file\n"
+ "\t-e\tErlang header file\n"
+ "\t-x\tCross compile. No dependencies to compiling emulator\n",
+ argv[0]);
return 1;
}
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index e3e8367b62..4d75883fc5 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -35,6 +35,17 @@
#include "hipe_stack.h"
#include "hipe_bif0.h" /* hipe_mfa_info_table_init() */
+#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \
+ if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN)
+# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \
+ if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN)
+#else
+# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P)
+# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P)
+#endif
+
+
/*
* Internal debug support.
* #define HIPE_DEBUG to the desired debug level:
@@ -318,8 +329,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
* Native code called a BIF, which "failed" with a TRAP to BEAM.
* Prior to returning, the BIF stored (see BIF_TRAP<N>):
- * the callee's address in p->def_arg_reg[3]
- * the callee's parameters in p->def_arg_reg[0..2]
+ * the callee's address in p->i
+ * the callee's parameters in reg[0..2]
* the callee's arity in p->arity (for BEAM gc purposes)
*
* We need to remove the BIF's parameters from the native
@@ -331,19 +342,8 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
*/
unsigned int i, is_recursive = 0;
- /* Save p->arity, then update it with the original BIF's arity.
- Get rid of any stacked parameters in that call. */
- /* XXX: hipe_call_from_native_is_recursive() copies data to
- reg[], which is useless in the TRAP case. Maybe write a
- specialised hipe_trap_from_native_is_recursive() later. */
if (p->hipe.nsp != NULL) {
- unsigned int callee_arity;
- callee_arity = p->arity;
- p->arity = p->hipe.narity; /* caller's arity */
- is_recursive = hipe_call_from_native_is_recursive(p, reg);
-
- p->i = (Eterm *)(p->def_arg_reg[3]);
- p->arity = callee_arity;
+ is_recursive = hipe_trap_from_native_is_recursive(p);
}
/* Schedule next process if current process was hibernated or is waiting
@@ -353,15 +353,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
goto do_schedule;
}
if (p->status == P_WAITING) {
+ for (i = 0; i < p->arity; ++i)
+ p->arg_reg[i] = reg[i];
goto do_schedule;
}
- for (i = 0; i < p->arity; ++i)
- reg[i] = p->def_arg_reg[i];
-
if (is_recursive)
hipe_push_beam_trap_frame(p, reg, p->arity);
-
+
result = HIPE_MODE_SWITCH_RES_CALL;
break;
}
@@ -470,10 +469,12 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
#if !(NR_ARG_REGS > 5)
int reds_in = p->def_arg_reg[5];
#endif
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p);
p = schedule(p, reds_in - p->fcalls);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(p);
#ifdef ERTS_SMP
p->hipe_smp.have_receive_locks = 0;
- reg = p->scheduler_data->save_reg;
+ reg = p->scheduler_data->x_reg_array;
#endif
}
{
@@ -648,7 +649,7 @@ Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s)
if (depth < 1)
return NIL;
- heap_size = 6 * depth; /* each [{M,F,A}|_] is 2+4 == 6 words */
+ heap_size = 7 * depth; /* each [{M,F,A,[]}|_] is 2+5 == 7 words */
hp = HAlloc(p, heap_size);
hp_end = hp + heap_size;
@@ -659,8 +660,8 @@ Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s)
ra = (const void*)s->trace[i];
if (!hipe_find_mfa_from_ra(ra, &m, &f, &a))
continue;
- mfa = TUPLE3(hp, m, f, make_small(a));
- hp += 4;
+ mfa = TUPLE4(hp, m, f, make_small(a), NIL);
+ hp += 5;
next = CONS(hp, mfa, NIL);
*next_p = next;
next_p = &CDR(list_val(next));
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index dfb4ca794a..3be821f8f7 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -41,9 +41,9 @@
*/
/* for -Wmissing-prototypes :-( */
-extern Eterm hipe_check_process_code_2(Process*, Eterm, Eterm);
-extern Eterm hipe_garbage_collect_1(Process*, Eterm);
-extern Eterm hipe_show_nstack_1(Process*, Eterm);
+extern Eterm hipe_check_process_code_2(BIF_ALIST_2);
+extern Eterm hipe_garbage_collect_1(BIF_ALIST_1);
+extern Eterm hipe_show_nstack_1(BIF_ALIST_1);
/* Used when a BIF can trigger a stack walk. */
static __inline__ void hipe_set_narity(Process *p, unsigned int arity)
@@ -56,7 +56,7 @@ Eterm hipe_check_process_code_2(BIF_ALIST_2)
Eterm ret;
hipe_set_narity(BIF_P, 2);
- ret = check_process_code_2(BIF_P, BIF_ARG_1, BIF_ARG_2);
+ ret = check_process_code_2(BIF_P, BIF__ARGS);
hipe_set_narity(BIF_P, 0);
return ret;
}
@@ -66,7 +66,7 @@ Eterm hipe_garbage_collect_1(BIF_ALIST_1)
Eterm ret;
hipe_set_narity(BIF_P, 1);
- ret = garbage_collect_1(BIF_P, BIF_ARG_1);
+ ret = garbage_collect_1(BIF_P, BIF__ARGS);
hipe_set_narity(BIF_P, 0);
return ret;
}
@@ -76,7 +76,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1)
Eterm ret;
hipe_set_narity(BIF_P, 1);
- ret = hipe_bifs_show_nstack_1(BIF_P, BIF_ARG_1);
+ ret = hipe_bifs_show_nstack_1(BIF_P, BIF__ARGS);
hipe_set_narity(BIF_P, 0);
return ret;
}
@@ -99,8 +99,10 @@ void hipe_gc(Process *p, Eterm need)
* has begun.
* XXX: BUG: native code should check return status
*/
-Eterm hipe_set_timeout(Process *p, Eterm timeout_value)
+BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm timeout_value = BIF_ARG_1;
#if !defined(ARCH_64)
Uint time_val;
#endif
@@ -187,6 +189,8 @@ void hipe_fclearerror_error(Process *p)
{
#if !defined(NO_FPE_SIGNALS)
erts_fp_check_init_error(&p->fp_exception);
+#else
+ erl_exit(ERTS_ABORT_EXIT, "Emulated FPE not cleared by HiPE");
#endif
}
@@ -286,8 +290,13 @@ static struct StackTrace *get_trace_from_exc(Eterm exc)
* This does what the (misnamed) Beam instruction 'raise_ss' does,
* namely, a proper re-throw of an exception that was caught by 'try'.
*/
-Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value)
+
+BIF_RETTYPE hipe_rethrow(BIF_ALIST_2)
{
+ Process* c_p = BIF_P;
+ Eterm exc = BIF_ARG_1;
+ Eterm value = BIF_ARG_2;
+
c_p->fvalue = value;
if (c_p->freason == EXC_NULL) {
/* a safety check for the R10-0 case; should not happen */
@@ -411,8 +420,12 @@ Eterm hipe_bs_utf8_size(Eterm arg)
return make_small(4);
}
-Eterm hipe_bs_put_utf8(Process *p, Eterm arg, byte *base, unsigned int offset)
+BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3)
{
+ Process* p = BIF_P;
+ Eterm arg = BIF_ARG_1;
+ byte* base = (byte*) BIF_ARG_2;
+ Uint offset = (Uint) BIF_ARG_3;
byte *save_bin_buf;
Uint save_bin_offset;
int res;
@@ -468,13 +481,21 @@ Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset,
return new_offset;
}
-Eterm hipe_bs_put_utf16be(Process *p, Eterm arg, byte *base, unsigned int offset)
+BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3)
{
+ Process *p = BIF_P;
+ Eterm arg = BIF_ARG_1;
+ byte *base = (byte*) BIF_ARG_2;
+ Uint offset = (Uint) BIF_ARG_3;
return hipe_bs_put_utf16(p, arg, base, offset, 0);
}
-Eterm hipe_bs_put_utf16le(Process *p, Eterm arg, byte *base, unsigned int offset)
+BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3)
{
+ Process *p = BIF_P;
+ Eterm arg = BIF_ARG_1;
+ byte *base = (byte*) BIF_ARG_2;
+ Uint offset = (Uint) BIF_ARG_3;
return hipe_bs_put_utf16(p, arg, base, offset, BSF_LITTLE);
}
@@ -489,8 +510,10 @@ static int validate_unicode(Eterm arg)
return 1;
}
-Eterm hipe_bs_validate_unicode(Process *p, Eterm arg)
+BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm arg = BIF_ARG_1;
if (!validate_unicode(arg))
BIF_ERROR(p, BADARG);
return NIL;
diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h
index 13a02b84a2..9e3a156fbc 100644
--- a/erts/emulator/hipe/hipe_native_bif.h
+++ b/erts/emulator/hipe/hipe_native_bif.h
@@ -23,6 +23,7 @@
#ifndef HIPE_NATIVE_BIF_H
#define HIPE_NATIVE_BIF_H
+#include "bif.h"
#include "hipe_arch.h"
/*
@@ -71,27 +72,32 @@ AEXTERN(void,nbif_select_msg,(Process*));
AEXTERN(Eterm,nbif_cmp_2,(void));
AEXTERN(Eterm,nbif_eq_2,(void));
-Eterm hipe_nonclosure_address(Process*, Eterm, Uint);
-Eterm hipe_conv_big_to_float(Process*, Eterm);
+BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2);
+BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1);
void hipe_fclearerror_error(Process*);
void hipe_select_msg(Process*);
void hipe_gc(Process*, Eterm);
-Eterm hipe_set_timeout(Process*, Eterm);
+BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1);
void hipe_handle_exception(Process*);
-Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value);
+BIF_RETTYPE hipe_rethrow(BIF_ALIST_2);
char *hipe_bs_allocate(int);
Binary *hipe_bs_reallocate(Binary*, int);
int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned);
void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned);
Eterm hipe_bs_utf8_size(Eterm);
-Eterm hipe_bs_put_utf8(Process*, Eterm, byte*, unsigned int);
+BIF_RETTYPE hipe_bs_put_utf8(BIF_ALIST_3);
Eterm hipe_bs_utf16_size(Eterm);
-Eterm hipe_bs_put_utf16be(Process*, Eterm, byte*, unsigned int);
-Eterm hipe_bs_put_utf16le(Process*, Eterm, byte*, unsigned int);
-Eterm hipe_bs_validate_unicode(Process*, Eterm);
+BIF_RETTYPE hipe_bs_put_utf16be(BIF_ALIST_3);
+BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3);
+BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1);
struct erl_bin_match_buffer;
int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm);
+#ifdef NO_FPE_SIGNALS
+AEXTERN(void,nbif_emulate_fpe,(Process*));
+void hipe_emulate_fpe(Process*);
+#endif
+
/*
* Stuff that is different in SMP and non-SMP.
*/
diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4
index 0eb5c441e6..343402f9f0 100644
--- a/erts/emulator/hipe/hipe_ppc_asm.m4
+++ b/erts/emulator/hipe/hipe_ppc_asm.m4
@@ -31,12 +31,23 @@ define(LOAD,ld)dnl
define(STORE,std)dnl
define(CMPI,cmpdi)dnl
define(WSIZE,8)dnl
+`#define STORE_IA(ADDR, DST, TMP) \
+ addis TMP, 0, ADDR@highest SEMI\
+ ori TMP, TMP, ADDR@higher SEMI\
+ rldicr TMP, TMP, 32, 31 SEMI\
+ oris TMP, TMP, ADDR@h SEMI\
+ ori TMP, TMP, ADDR@l SEMI\
+ std TMP, DST'
',`
/* 32-bit PowerPC */
define(LOAD,lwz)dnl
define(STORE,stw)dnl
define(CMPI,cmpwi)dnl
define(WSIZE,4)dnl
+`#define STORE_IA(ADDR, DST, TMP) \
+ lis TMP, ADDR@ha SEMI\
+ addi TMP, TMP, ADDR@l SEMI\
+ stw TMP, DST'
')dnl
`#define LOAD 'LOAD
`#define STORE 'STORE
diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4
index 203fefe1a1..d09551d10d 100644
--- a/erts/emulator/hipe/hipe_ppc_bifs.m4
+++ b/erts/emulator/hipe/hipe_ppc_bifs.m4
@@ -20,21 +20,34 @@ changecom(`/*', `*/')dnl
include(`hipe/hipe_ppc_asm.m4')
+#`include' "config.h"
#`include' "hipe_literals.h"
+`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+# define CALL_BIF(F) STORE_IA(CSYM(F), P_BIF_CALLEE(P), r29); bl CSYM(hipe_debug_bif_wrapper)
+#else
+# define CALL_BIF(F) bl CSYM(F)
+#endif'
+
.text
.p2align 2
-`#define TEST_GOT_MBUF LOAD r4, P_MBUF(P) SEMI CMPI r4, 0 SEMI bne- 3f SEMI 2:
-#define JOIN3(A,B,C) A##B##C
-#define HANDLE_GOT_MBUF(ARITY) 3: bl CSYM(JOIN3(nbif_,ARITY,_gc_after_bif)) SEMI b 2b'
+define(TEST_GOT_MBUF,`LOAD r4, P_MBUF(P) # `TEST_GOT_MBUF'
+ CMPI r4, 0
+ bne- 3f
+2:')
+define(HANDLE_GOT_MBUF,`
+3: bl CSYM(nbif_$1_gc_after_bif) # `HANDLE_GOT_MBUF'
+ b 2b')
+
/*
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 1-3 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -49,7 +62,9 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl CSYM($2)
+ STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[]
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. Check for exception. */
@@ -77,7 +92,10 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl CSYM($2)
+ STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[]
+ STORE r5, P_ARG1(r3)
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. Check for exception. */
@@ -106,7 +124,11 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl CSYM($2)
+ STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[]
+ STORE r5, P_ARG1(r3)
+ STORE r6, P_ARG2(r3)
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. Check for exception. */
@@ -121,13 +143,7 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
-/*
- * fail_bif_interface_0(nbif_name, cbif_name)
- *
- * Generate native interface for a BIF with 0 parameters and
- * standard failure mode.
- */
-define(fail_bif_interface_0,
+define(standard_bif_interface_0,
`
#ifndef HAVE_$1
#`define' HAVE_$1
@@ -138,7 +154,8 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- bl CSYM($2)
+ /* ignore empty BIF__ARGS */
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. Check for exception. */
@@ -173,7 +190,8 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_GC
- bl CSYM($2)
+ /* ignore empty BIF__ARGS */
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. */
@@ -196,7 +214,9 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_GC
- bl CSYM($2)
+ STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[]
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. Check for exception. */
@@ -224,7 +244,10 @@ ASYM($1):
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_GC
- bl CSYM($2)
+ STORE r4, P_ARG0(r3) # Store BIF__ARGS in def_arg_reg[]
+ STORE r5, P_ARG1(r3)
+ addi r4, r3, P_ARG0
+ CALL_BIF($2)
TEST_GOT_MBUF
/* Restore registers. Check for exception. */
diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h
index 94113ffcd8..38509c105b 100644
--- a/erts/emulator/hipe/hipe_primops.h
+++ b/erts/emulator/hipe/hipe_primops.h
@@ -77,6 +77,10 @@ PRIMOP_LIST(am_nonclosure_address, &nbif_nonclosure_address)
PRIMOP_LIST(am_conv_big_to_float, &nbif_conv_big_to_float)
PRIMOP_LIST(am_fclearerror_error, &nbif_fclearerror_error)
+#ifdef NO_FPE_SIGNALS
+PRIMOP_LIST(am_emulate_fpe, &nbif_emulate_fpe)
+#endif
+
#if defined(__sparc__)
#include "hipe_sparc_primops.h"
#endif
diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h
index 5effacb398..4ee99d78a2 100644
--- a/erts/emulator/hipe/hipe_process.h
+++ b/erts/emulator/hipe/hipe_process.h
@@ -42,6 +42,12 @@ struct hipe_process_state {
void (*nra)(void); /* Native code return address. */
#endif
unsigned int narity; /* Arity of BIF call, for stack walks. */
+#ifdef NO_FPE_SIGNALS
+ double float_result; /* to be checked for inf/NaN by hipe_emulate_fpe */
+#endif
+#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+ void (*bif_callee)(void); /* When calling BIF's via debug wrapper */
+#endif
};
extern void hipe_arch_print_pcb(struct hipe_process_state *p);
diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h
index e74023e3e9..cc2671c016 100644
--- a/erts/emulator/hipe/hipe_risc_glue.h
+++ b/erts/emulator/hipe/hipe_risc_glue.h
@@ -199,6 +199,22 @@ hipe_call_from_native_is_recursive(Process *p, Eterm reg[])
return 0;
}
+/* BEAM called native, which called BIF that returned trap
+ * Discard bif parameters.
+ * If tailcall, also clean up native stub continuation. */
+static __inline__ int
+hipe_trap_from_native_is_recursive(Process *p)
+{
+ if (p->hipe.narity > NR_ARG_REGS) {
+ p->hipe.nsp += (p->hipe.narity - NR_ARG_REGS);
+ }
+ if (p->hipe.nra != (void(*)(void))&nbif_return)
+ return 1;
+ hipe_pop_risc_nra_frame(p);
+ return 0;
+}
+
+
/* Native makes a call which needs to unload the parameters.
This differs from hipe_call_from_native_is_recursive() in
that it doesn't check for or pop the BEAM-calls-native frame.
diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4
index 03db7f3413..ca5af45d58 100644
--- a/erts/emulator/hipe/hipe_sparc_bifs.m4
+++ b/erts/emulator/hipe/hipe_sparc_bifs.m4
@@ -20,27 +20,42 @@ changecom(`/*', `*/')dnl
include(`hipe/hipe_sparc_asm.m4')
+#`include' "config.h"
#`include' "hipe_literals.h"
.section ".text"
.align 4
+`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+# define CALL_BIF(F) set F, %o7; st %o7, [%o0+P_BIF_CALLEE]; call hipe_debug_bif_wrapper
+#else
+# define CALL_BIF(F) call F
+#endif'
+
/*
* Test for exception. This macro executes its delay slot.
*/
-`#define __TEST_GOT_EXN(LABEL) cmp %o0, THE_NON_VALUE; bz,pn %icc, LABEL
-#define TEST_GOT_EXN(ARITY) __TEST_GOT_EXN(JOIN3(nbif_,ARITY,_simple_exception))'
+define(TEST_GOT_EXN,`cmp %o0, THE_NON_VALUE ! `TEST_GOT_EXN'
+ bz,pn %icc, nbif_$1_simple_exception')
-`#define TEST_GOT_MBUF ld [P+P_MBUF], %o1; cmp %o1, 0; bne 3f; nop; 2:
-#define JOIN3(A,B,C) A##B##C
-#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); nop; b 2b; nop'
+define(TEST_GOT_MBUF,`ld [P+P_MBUF], %o1 ! `TEST_GOT_MBUF'
+ cmp %o1, 0
+ bne 3f
+ nop
+2:')
+define(HANDLE_GOT_MBUF,`
+3: call nbif_$1_gc_after_bif ! `HANDLE_GOT_MBUF'
+ nop
+ b 2b
+ nop')
/*
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 1-3 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -55,7 +70,9 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- call $2
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
@@ -81,7 +98,10 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- call $2
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ st %o2, [%o0+P_ARG1]
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
@@ -108,7 +128,11 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- call $2
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ st %o2, [%o0+P_ARG1]
+ st %o3, [%o0+P_ARG2]
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
@@ -121,13 +145,7 @@ $1:
.type $1, #function
#endif')
-/*
- * fail_bif_interface_0(nbif_name, cbif_name)
- *
- * Generate native interface for a BIF with 0 parameters and
- * standard failure mode.
- */
-define(fail_bif_interface_0,
+define(standard_bif_interface_0,
`
#ifndef HAVE_$1
#`define' HAVE_$1
@@ -138,7 +156,8 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_BIF
- call $2
+ /* ignore empty BIF__ARGS */
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
@@ -171,7 +190,8 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_GC
- call $2
+ /* ignore empty BIF__ARGS */
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
@@ -195,7 +215,9 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_GC
- call $2
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
@@ -221,7 +243,10 @@ $1:
/* Save caller-save registers and call the C function. */
SAVE_CONTEXT_GC
- call $2
+ st %o1, [%o0+P_ARG0] ! Store BIF__ARGS in def_arg_reg
+ st %o2, [%o0+P_ARG1]
+ add %o0, P_ARG0, %o1
+ CALL_BIF($2)
nop
TEST_GOT_MBUF
diff --git a/erts/emulator/hipe/hipe_x86.h b/erts/emulator/hipe/hipe_x86.h
index f0f3c158af..97f09e38cd 100644
--- a/erts/emulator/hipe/hipe_x86.h
+++ b/erts/emulator/hipe/hipe_x86.h
@@ -49,7 +49,9 @@ static __inline__ int hipe_word32_address_ok(void *address)
#define hipe_arch_name am_x86
extern void nbif_inc_stack_0(void);
+#ifndef NO_FPE_SIGNALS
extern void nbif_handle_fp_exception(void);
+#endif
/* for hipe_bifs_enter_code_2 */
extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p);
diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4
index 1bb6488b00..3cb7d67be0 100644
--- a/erts/emulator/hipe/hipe_x86_bifs.m4
+++ b/erts/emulator/hipe/hipe_x86_bifs.m4
@@ -20,6 +20,7 @@ changecom(`/*', `*/')dnl
include(`hipe/hipe_x86_asm.m4')
+#`include' "config.h"
#`include' "hipe_literals.h"
`#if THE_NON_VALUE == 0
@@ -28,16 +29,27 @@ include(`hipe/hipe_x86_asm.m4')
#define TEST_GOT_EXN cmpl $THE_NON_VALUE,%eax
#endif'
-`#define TEST_GOT_MBUF movl P_MBUF(P), %edx; testl %edx, %edx; jnz 3f; 2:
-#define JOIN3(A,B,C) A##B##C
-#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b'
+`#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+# define CALL_BIF(F) movl $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper)
+#else
+# define CALL_BIF(F) call CSYM(F)
+#endif'
+
+define(TEST_GOT_MBUF,`movl P_MBUF(P), %edx # `TEST_GOT_MBUF'
+ testl %edx, %edx
+ jnz 3f
+2:')
+define(HANDLE_GOT_MBUF,`
+3: call nbif_$1_gc_after_bif # `HANDLE_GOT_MBUF'
+ jmp 2b')
/*
* standard_bif_interface_1(nbif_name, cbif_name)
* standard_bif_interface_2(nbif_name, cbif_name)
* standard_bif_interface_3(nbif_name, cbif_name)
+ * standard_bif_interface_0(nbif_name, cbif_name)
*
- * Generate native interface for a BIF with 1-3 parameters and
+ * Generate native interface for a BIF with 0-3 parameters and
* standard failure mode.
*/
define(standard_bif_interface_1,
@@ -56,8 +68,10 @@ ASYM($1):
/* make the call on the C stack */
NBIF_ARG_REG(0,P)
- NBIF_ARG(1,1,0)
- call CSYM($2)
+ NBIF_ARG(2,1,0)
+ lea 8(%esp), %eax
+ NBIF_ARG_REG(1,%eax) # BIF__ARGS
+ CALL_BIF($2)
TEST_GOT_MBUF
/* switch to native stack */
@@ -88,9 +102,11 @@ ASYM($1):
/* make the call on the C stack */
NBIF_ARG_REG(0,P)
- NBIF_ARG(1,2,0)
- NBIF_ARG(2,2,1)
- call CSYM($2)
+ NBIF_ARG(2,2,0)
+ NBIF_ARG(3,2,1)
+ lea 8(%esp), %eax
+ NBIF_ARG_REG(1,%eax) # BIF__ARGS
+ CALL_BIF($2)
TEST_GOT_MBUF
/* switch to native stack */
@@ -121,10 +137,12 @@ ASYM($1):
/* make the call on the C stack */
NBIF_ARG_REG(0,P)
- NBIF_ARG(1,3,0)
- NBIF_ARG(2,3,1)
- NBIF_ARG(3,3,2)
- call CSYM($2)
+ NBIF_ARG(2,3,0)
+ NBIF_ARG(3,3,1)
+ NBIF_ARG(4,3,2)
+ lea 8(%esp), %eax
+ NBIF_ARG_REG(1,%eax) # BIF__ARGS
+ CALL_BIF($2)
TEST_GOT_MBUF
/* switch to native stack */
@@ -139,13 +157,7 @@ ASYM($1):
TYPE_FUNCTION(ASYM($1))
#endif')
-/*
- * fail_bif_interface_0(nbif_name, cbif_name)
- *
- * Generate native interface for a BIF with 0 parameters and
- * standard failure mode.
- */
-define(fail_bif_interface_0,
+define(standard_bif_interface_0,
`
#ifndef HAVE_$1
#`define' HAVE_$1
@@ -158,7 +170,8 @@ ASYM($1):
/* make the call on the C stack */
NBIF_ARG_REG(0,P)
- call CSYM($2)
+ /* skip BIF__ARGS */
+ CALL_BIF($2)
TEST_GOT_MBUF
/* switch to native stack */
@@ -608,7 +621,9 @@ ASYM($1):
/*
* x86-specific primops.
*/
+#ifndef NO_FPE_SIGNALS
noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu)
+#endif /* NO_FPE_SIGNALS */
/*
* Implement gc_bif_interface_0 as nofail_primop_interface_0.
diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h
index a7b0f164be..b0db93267c 100644
--- a/erts/emulator/hipe/hipe_x86_glue.h
+++ b/erts/emulator/hipe/hipe_x86_glue.h
@@ -186,6 +186,25 @@ hipe_call_from_native_is_recursive(Process *p, Eterm reg[])
return 0;
}
+/* BEAM called native, which called BIF that returned trap
+ * Discard bif parameters.
+ * If tailcall, also clean up native stub continuation. */
+static __inline__ int
+hipe_trap_from_native_is_recursive(Process *p)
+{
+ Eterm nra = *(p->hipe.nsp++);
+
+ if (p->hipe.narity > NR_ARG_REGS) {
+ p->hipe.nsp += (p->hipe.narity - NR_ARG_REGS);
+ }
+ if (nra != (Eterm)nbif_return) {
+ *--(p->hipe.nsp) = nra;
+ return 1;
+ }
+ return 0;
+}
+
+
/* Native makes a call which needs to unload the parameters.
This differs from hipe_call_from_native_is_recursive() in
that it doesn't check for or pop the BEAM-calls-native frame.
diff --git a/erts/emulator/hipe/hipe_x86_primops.h b/erts/emulator/hipe/hipe_x86_primops.h
index 96d2336bc5..111b1fa8bd 100644
--- a/erts/emulator/hipe/hipe_x86_primops.h
+++ b/erts/emulator/hipe/hipe_x86_primops.h
@@ -19,4 +19,7 @@
PRIMOP_LIST(am_inc_stack_0, &nbif_inc_stack_0)
+#ifndef NO_FPE_SIGNALS
PRIMOP_LIST(am_handle_fp_exception, &nbif_handle_fp_exception)
+#endif
+
diff --git a/erts/emulator/pcre/Makefile b/erts/emulator/pcre/Makefile
deleted file mode 100644
index 72eea01130..0000000000
--- a/erts/emulator/pcre/Makefile
+++ /dev/null
@@ -1,26 +0,0 @@
-#
-# %CopyrightBegin%
-#
-# Copyright Ericsson AB 2008-2009. All Rights Reserved.
-#
-# The contents of this file are subject to the Erlang Public License,
-# Version 1.1, (the "License"); you may not use this file except in
-# compliance with the License. You should have received a copy of the
-# Erlang Public License along with this software. If not, it can be
-# retrieved online at http://www.erlang.org/.
-#
-# Software distributed under the License is distributed on an "AS IS"
-# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-# the License for the specific language governing rights and limitations
-# under the License.
-#
-# %CopyrightEnd%
-#
-#
-# Invoke with GNU make or clearmake -C gnu.
-#
-
-include $(ERL_TOP)/make/run_make.mk
-
-table:
- $(MAKE) -f $(TARGET)/Makefile $@ \ No newline at end of file
diff --git a/erts/emulator/pcre/Makefile.in b/erts/emulator/pcre/Makefile.in
deleted file mode 100644
index f62700ec4e..0000000000
--- a/erts/emulator/pcre/Makefile.in
+++ /dev/null
@@ -1,165 +0,0 @@
-# Makefile for zlib
-# Copyright (C) 1995-1996 Jean-loup Gailly.
-# For conditions of distribution and use, see copyright notice in zlib.h
-
-# To compile and test, type:
-# ./configure; make test
-# The call of configure is optional if you don't have special requirements
-
-# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type:
-# make install
-# To install in $HOME instead of /usr/local, use:
-# make install prefix=$HOME
-
-# %ExternalCopyright%
-
-ARFLAGS = rc
-
-O = \
-pcre_latin_1_table.o \
-pcre_compile.o \
-pcre_config.o \
-pcre_dfa_exec.o \
-pcre_exec.o \
-pcre_fullinfo.o \
-pcre_get.o \
-pcre_globals.o \
-pcre_info.o \
-pcre_maketables.o \
-pcre_newline.o \
-pcre_ord2utf8.o \
-pcre_refcount.o \
-pcre_study.o \
-pcre_tables.o \
-pcre_try_flipped.o \
-pcre_ucp_searchfuncs.o \
-pcre_valid_utf8.o \
-pcre_version.o \
-pcre_xclass.o
-
-OBJS = $(O:%=$(OBJDIR)/%)
-
-GENINC = pcre_exec_loop_break_cases.inc
-
-#### Begin OTP targets
-
-include $(ERL_TOP)/make/target.mk
-
-# On windows we need a separate zlib during debug build
-ifeq ($(TARGET),win32)
-
-ifeq ($(TYPE),debug)
-CFLAGS = $(subst -O2, -g, @CFLAGS@ @DEFS@ @DEBUG_FLAGS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION)
-else # debug
-CFLAGS = @CFLAGS@ @DEFS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION
-endif # debug
-
-else # win32
-
-ifeq ($(TYPE),debug)
-TYPE_FLAGS = @DEBUG_CFLAGS@
-else # debug
-ifeq ($(TYPE),gcov)
-TYPE_FLAGS = -O0 -fprofile-arcs -ftest-coverage
-else # gcov
-TYPE_FLAGS = -O3
-endif # gcov
-endif # debug
-
-CFLAGS = $(TYPE_FLAGS) $(subst -O2,, @CFLAGS@) @DEFS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION
-
-endif # win32
-
-OBJDIR = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)
-
-include $(ERL_TOP)/make/$(TARGET)/otp.mk
-
-ifeq ($(TARGET), win32)
-LIBRARY=$(OBJDIR)/epcre.lib
-else
-LIBRARY=$(OBJDIR)/libepcre.a
-endif
-
-all: $(LIBRARY)
-
-# ----------------------------------------------------
-# Release Target
-# ----------------------------------------------------
-include $(ERL_TOP)/make/otp_release_targets.mk
-
-release_spec: opt
-
-tests release_tests:
-
-docs release_docs release_docs_spec:
-
-clean:
- rm -f $(OBJS) $(OBJDIR)/libepcre.a
-
-#### end OTP targets
-
-ifeq ($(TARGET), win32)
-$(LIBRARY): $(OBJS)
- $(AR) -out:$@ $(OBJS)
-else
-$(LIBRARY): $(OBJS)
- $(AR) $(ARFLAGS) $@ $(OBJS)
- -@ ($(RANLIB) $@ || true) 2>/dev/null
-endif
-
-$(OBJDIR)/%.o: %.c
- $(CC) -c $(CFLAGS) -o $@ $<
-
-$(GENINC): pcre_exec.c
- for x in `grep -n COST_CHK 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};"; \
- done > $(GENINC)
-
-table: ./gen_table
- ./gen_table pcre_latin_1_table.c
-
-./gen_table: pcre_make_latin1_default.c make_latin1_table.c
- $(CC) $(CFLAGS) -o gen_table pcre_make_latin1_default.c make_latin1_table.c
-
-# DO NOT DELETE THIS LINE -- make depend depends on it.
-
-$(OBJDIR)/pcre_chartables.o: pcre_chartables.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_compile.o: pcre_compile.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_config.o: pcre_config.c pcre_internal.h local_config.h pcre.h \
- ucp.h
-$(OBJDIR)/pcre_dfa_exec.o: pcre_dfa_exec.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_exec.o: pcre_exec.c pcre_internal.h local_config.h pcre.h ucp.h \
- $(GENINC)
-$(OBJDIR)/pcre_fullinfo.o: pcre_fullinfo.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_get.o: pcre_get.c pcre_internal.h local_config.h pcre.h ucp.h
-$(OBJDIR)/pcre_globals.o: pcre_globals.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_info.o: pcre_info.c pcre_internal.h local_config.h pcre.h ucp.h
-$(OBJDIR)/pcre_maketables.o: pcre_maketables.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_newline.o: pcre_newline.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_ord2utf8.o: pcre_ord2utf8.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_refcount.o: pcre_refcount.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-$(OBJDIR)/pcre_study.o: pcre_study.c pcre_internal.h local_config.h pcre.h \
- ucp.h
-$(OBJDIR)/pcre_tables.o: pcre_tables.c pcre_internal.h local_config.h pcre.h \
- ucp.h
-$(OBJDIR)/pcre_try_flipped.o: pcre_try_flipped.c pcre_internal.h \
- local_config.h pcre.h ucp.h
-$(OBJDIR)/pcre_ucp_searchfuncs.o: pcre_ucp_searchfuncs.c pcre_internal.h \
- local_config.h pcre.h ucp.h ucpinternal.h ucptable.h
-$(OBJDIR)/pcre_valid_utf8.o: pcre_valid_utf8.c pcre_internal.h local_config.h \
- pcre.h ucp.h
-pcre_version.o: pcre_version.c pcre_internal.h local_config.h pcre.h \
- ucp.h
-$(OBJDIR)/pcre_xclass.o: pcre_xclass.c pcre_internal.h local_config.h pcre.h \
- ucp.h
diff --git a/erts/emulator/pcre/pcre.mk b/erts/emulator/pcre/pcre.mk
new file mode 100644
index 0000000000..b752c11459
--- /dev/null
+++ b/erts/emulator/pcre/pcre.mk
@@ -0,0 +1,113 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2011. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ARFLAGS = rc
+
+PCRE_O = \
+pcre_latin_1_table.o \
+pcre_compile.o \
+pcre_config.o \
+pcre_dfa_exec.o \
+pcre_exec.o \
+pcre_fullinfo.o \
+pcre_get.o \
+pcre_globals.o \
+pcre_info.o \
+pcre_maketables.o \
+pcre_newline.o \
+pcre_ord2utf8.o \
+pcre_refcount.o \
+pcre_study.o \
+pcre_tables.o \
+pcre_try_flipped.o \
+pcre_ucp_searchfuncs.o \
+pcre_valid_utf8.o \
+pcre_version.o \
+pcre_xclass.o
+
+PCRE_OBJS = $(PCRE_O:%=$(PCRE_OBJDIR)/%)
+
+GENINC = pcre/pcre_exec_loop_break_cases.inc
+
+PCRE_OBJDIR = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)
+
+PCRE_CFLAGS = $(filter-out -DDEBUG,$(CFLAGS)) -DERLANG_INTEGRATION
+
+ifeq ($(TARGET), win32)
+$(EPCRE_LIB): $(PCRE_OBJS)
+ $(AR) -out:$@ $(PCRE_OBJS)
+else
+$(EPCRE_LIB): $(PCRE_OBJS)
+ $(AR) $(ARFLAGS) $@ $(PCRE_OBJS)
+ -@ ($(RANLIB) $@ || true) 2>/dev/null
+endif
+
+$(PCRE_OBJDIR)/%.o: pcre/%.c
+ $(CC) -c $(PCRE_CFLAGS) -o $@ $<
+
+$(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}'`; \
+ do \
+ N=`expr $$x + 100`; \
+ echo "case $$N: goto L_LOOP_COUNT_$${x};"; \
+ done > $(GENINC)
+
+# Dependencies.
+
+$(PCRE_OBJDIR)/pcre_chartables.o: pcre/pcre_chartables.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_compile.o: pcre/pcre_compile.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_config.o: pcre/pcre_config.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_dfa_exec.o: pcre/pcre_dfa_exec.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_exec.o: pcre/pcre_exec.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h $(GENINC)
+$(PCRE_OBJDIR)/pcre_fullinfo.o: pcre/pcre_fullinfo.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_get.o: pcre/pcre_get.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_globals.o: pcre/pcre_globals.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_info.o: pcre/pcre_info.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_maketables.o: pcre/pcre_maketables.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_newline.o: pcre/pcre_newline.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_ord2utf8.o: pcre/pcre_ord2utf8.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre/pcre_refcount.o: pcre/pcre_refcount.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_study.o: pcre/pcre_study.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_tables.o: pcre/pcre_tables.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_try_flipped.o: pcre/pcre_try_flipped.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre_ucp_searchfuncs.o: pcre/pcre_ucp_searchfuncs.c \
+ pcre/pcre_internal.h pcre/local_config.h pcre/pcre.h pcre/ucp.h \
+ pcre/ucpinternal.h pcre/ucptable.h
+$(PCRE_OBJDIR)/pcre_valid_utf8.o: pcre/pcre_valid_utf8.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
+pcre_version.o: pcre/pcre_version.c pcre/pcre_internal.h pcre/local_config.h \
+ pcre/pcre.h pcre/ucp.h
+$(PCRE_OBJDIR)/pcre/pcre_xclass.o: pcre/pcre_xclass.c pcre/pcre_internal.h \
+ pcre/local_config.h pcre/pcre.h pcre/ucp.h
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 49750ff6ce..db2854fa40 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -371,20 +371,30 @@ 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
#if HALFWORD_HEAP
if (mk == &ma->low_mem) {
- res = pmunmap((void *) seg, size);
+#ifdef DEBUG
+ res =
+#endif
+ 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
- res = munmap((void *) seg, size);
+#ifdef DEBUG
+ res =
+#endif
+ munmap((void *) seg, size);
#else
# error "Missing mseg_destroy() implementation"
#endif
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 7f851e6007..c6b63350e5 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -948,18 +948,13 @@ void
os_flavor(char* namebuf, /* Where to return the name. */
unsigned size) /* Size of name buffer. */
{
- static int called = 0;
- static struct utsname uts; /* Information about the system. */
-
- if (!called) {
- char* s;
+ struct utsname uts; /* Information about the system. */
+ char* s;
- (void) uname(&uts);
- called = 1;
- for (s = uts.sysname; *s; s++) {
- if (isupper((int) *s)) {
- *s = tolower((int) *s);
- }
+ (void) uname(&uts);
+ for (s = uts.sysname; *s; s++) {
+ if (isupper((int) *s)) {
+ *s = tolower((int) *s);
}
}
strcpy(namebuf, uts.sysname);
@@ -2764,8 +2759,8 @@ smp_sig_notify(char c)
static void *
signal_dispatcher_thread_func(void *unused)
{
- int initialized = 0;
#if !CHLDWTHR
+ int initialized = 0;
int notify_check_children = 0;
#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
@@ -2805,8 +2800,8 @@ signal_dispatcher_thread_func(void *unused)
*/
switch (buf[i]) {
case 0: /* Emulator initialized */
- initialized = 1;
#if !CHLDWTHR
+ initialized = 1;
if (!notify_check_children)
#endif
break;
diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c
index fc7e6cec08..d6d1fe64e0 100644
--- a/erts/emulator/sys/vxworks/sys.c
+++ b/erts/emulator/sys/vxworks/sys.c
@@ -2036,9 +2036,6 @@ int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5,
erts_printf("The memory block used by elib is save_malloc'ed "
"at 0x%08x.\n", (unsigned int) alloc_pool_ptr);
}
-#ifdef NO_FIX_ALLOC
- erts_printf("Fix_alloc is disabled in this build\n");
-#endif
erts_printf("Statistics from elib_malloc:\n");
ELIB_LOCK;
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 4d0c87bf12..08d2066da3 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -61,7 +61,7 @@ MODULES= \
exception_SUITE \
float_SUITE \
fun_SUITE \
- fun_r12_SUITE \
+ fun_r13_SUITE \
gc_SUITE \
guard_SUITE \
hash_SUITE \
diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl
index 3487917677..413bd3bcae 100644
--- a/erts/emulator/test/big_SUITE.erl
+++ b/erts/emulator/test/big_SUITE.erl
@@ -26,7 +26,7 @@
shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]).
%% Internal exports.
--export([eval/1, funcall/2]).
+-export([eval/1]).
-export([init/3]).
-export([fac/1, fib/1, pow/2, gcd/2, lcm/2]).
@@ -162,12 +162,15 @@ multi_match([Node|Ns], Expr, Rs) ->
multi_match([], _, Rs) -> Rs.
eval(Expr) ->
- Fun = {?MODULE,funcall},
- {value,V,_} = erl_eval:expr(Expr, [], Fun), %Applied arithmetic BIFs.
- V = eval(Expr, Fun), %Real arithmetic instructions.
- V.
+ LFH = fun(Name, As) -> apply(?MODULE, Name, As) end,
+
+ %% Applied arithmetic BIFs.
+ {value,V,_} = erl_eval:expr(Expr, [], {value,LFH}),
-funcall(F, As) -> apply(?MODULE, F, As).
+ %% Real arithmetic instructions.
+ V = eval(Expr, LFH),
+
+ V.
%% Like a subset of erl_eval:expr/3, but uses real arithmetic instructions instead of
%% applying them (it does make a difference).
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index fed5854112..d9fc876482 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -33,7 +33,6 @@
%% erlang:external_size/1
%% size(Binary)
%% iolist_size/1
-%% concat_binary/1
%% split_binary/2
%% hash(Binary, N)
%% phash(Binary, N)
@@ -47,7 +46,7 @@
init_per_testcase/2, end_per_testcase/2,
copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1,
bad_list_to_binary/1, bad_binary_to_list/1,
- t_split_binary/1, bad_split/1, t_concat_binary/1,
+ t_split_binary/1, bad_split/1,
terms/1, terms_float/1, external_size/1, t_iolist_size/1,
t_hash/1,
bad_size/1,
@@ -68,7 +67,7 @@ suite() -> [{ct_hooks,[ts_install_cth]},
all() ->
[copy_terms, conversions, deep_lists, deep_bitstr_lists,
- t_split_binary, bad_split, t_concat_binary,
+ t_split_binary, bad_split,
bad_list_to_binary, bad_binary_to_list, terms,
terms_float, external_size, t_iolist_size,
bad_binary_to_term_2, safe_binary_to_term2,
@@ -93,7 +92,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Config.
@@ -381,41 +379,6 @@ bad_split(Config) when is_list(Config) ->
bad_split(Bin, Pos) ->
{'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)).
-%% Tests concat_binary/2 and size/1.
-
-t_concat_binary(suite) -> [];
-t_concat_binary(Config) when is_list(Config) ->
- test_concat([]),
-
- test_concat([[]]),
- test_concat([[], []]),
- test_concat([[], [], []]),
-
- test_concat([[1], []]),
- test_concat([[], [2]]),
- test_concat([[], [3], []]),
-
- test_concat([[1, 2, 3], [4, 5, 6, 7]]),
- test_concat([[1, 2, 3], [4, 5, 6, 7], [9, 10]]),
-
- test_concat([lists:seq(0, 255), lists:duplicate(1024, $@),
- lists:duplicate(2048, $a),
- lists:duplicate(4000, $b)]),
- ok.
-
-test_concat(Lists) ->
- test_concat(Lists, 0, [], []).
-
-test_concat([List|Rest], Size, Combined, Binaries) ->
- ?line Bin = list_to_binary(List),
- ?line test_concat(Rest, Size+length(List), Combined++List, [Bin|Binaries]);
-test_concat([], Size, Combined, Binaries0) ->
- ?line Binaries = lists:reverse(Binaries0),
- ?line Bin = concat_binary(Binaries),
- ?line Size = size(Bin),
- ?line Size = iolist_size(Bin),
- ?line Combined = binary_to_list(Bin).
-
t_hash(doc) -> "Test hash/2 with different type of binaries.";
t_hash(Config) when is_list(Config) ->
test_hash([]),
diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl
index b022f96740..15427661f3 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -23,7 +23,7 @@
bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
kenneth/1,encode_binary/1,native/1,happi/1,
size_var/1,wiger/1,x0_context/1,huge_float_field/1,
- writable_binary_matched/1,otp_7198/1]).
+ writable_binary_matched/1,otp_7198/1,unordered_bindings/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -33,7 +33,7 @@ all() ->
[bound_var, bound_tail, t_float, little_float, sean,
kenneth, encode_binary, native, happi, size_var, wiger,
x0_context, huge_float_field, writable_binary_matched,
- otp_7198].
+ otp_7198, unordered_bindings].
groups() ->
[].
@@ -553,5 +553,15 @@ otp_7198_scan(<<C, Rest/binary>>, TokAcc) when
otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc])
end.
+unordered_bindings(Config) when is_list(Config) ->
+ {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} =
+ unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>),
+ ok.
+
+unordered_bindings(CompressedLength, HashSize, PadLength, T) ->
+ <<Content:CompressedLength/binary,Mac:HashSize/binary,
+ Padding:PadLength/binary,PadLength>> = T,
+ {Content,Mac,Padding}.
+
id(I) -> I.
diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl
index 72c656c400..4ab7d674a6 100644
--- a/erts/emulator/test/bs_utf_SUITE.erl
+++ b/erts/emulator/test/bs_utf_SUITE.erl
@@ -64,8 +64,7 @@ end_per_group(_GroupName, Config) ->
utf8_roundtrip(Config) when is_list(Config) ->
?line utf8_roundtrip(0, 16#D7FF),
- ?line utf8_roundtrip(16#E000, 16#FFFD),
- ?line utf8_roundtrip(16#10000, 16#10FFFF),
+ ?line utf8_roundtrip(16#E000, 16#10FFFF),
ok.
utf8_roundtrip(First, Last) when First =< Last ->
@@ -91,8 +90,7 @@ utf16_roundtrip(Config) when is_list(Config) ->
do_utf16_roundtrip(Fun) ->
do_utf16_roundtrip(0, 16#D7FF, Fun),
- do_utf16_roundtrip(16#E000, 16#FFFD, Fun),
- do_utf16_roundtrip(16#10000, 16#10FFFF, Fun).
+ do_utf16_roundtrip(16#E000, 16#10FFFF, Fun).
do_utf16_roundtrip(First, Last, Fun) when First =< Last ->
Fun(First),
@@ -129,8 +127,7 @@ utf32_roundtrip(Config) when is_list(Config) ->
do_utf32_roundtrip(Fun) ->
do_utf32_roundtrip(0, 16#D7FF, Fun),
- do_utf32_roundtrip(16#E000, 16#FFFD, Fun),
- do_utf32_roundtrip(16#10000, 16#10FFFF, Fun).
+ do_utf32_roundtrip(16#E000, 16#10FFFF, Fun).
do_utf32_roundtrip(First, Last, Fun) when First =< Last ->
Fun(First),
@@ -158,7 +155,6 @@ utf32_little_roundtrip(Char) ->
utf8_illegal_sequences(Config) when is_list(Config) ->
?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
- ?line fail_range(16#FFFE, 16#FFFF), %Non-characters.
%% Illegal first character.
?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)],
@@ -251,7 +247,6 @@ fail_1(_) -> ok.
utf16_illegal_sequences(Config) when is_list(Config) ->
?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
- ?line utf16_fail_range(16#FFFE, 16#FFFF), %Non-characters.
?line lonely_hi_surrogate(16#D800, 16#DFFF),
?line leading_lo_surrogate(16#DC00, 16#DFFF),
@@ -300,7 +295,6 @@ leading_lo_surrogate(_, _, _) -> ok.
utf32_illegal_sequences(Config) when is_list(Config) ->
?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
- ?line utf32_fail_range(16#FFFE, 16#FFFF), %Non-characters.
?line utf32_fail_range(-100, -1),
ok.
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index 93fdc157f7..3e2bee06d1 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -934,6 +934,10 @@ exception_nocatch(Config) when is_list(Config) ->
exception_nocatch().
exception_nocatch() ->
+ Deep4LocThrow = get_deep_4_loc({throw,[42]}),
+ Deep4LocError = get_deep_4_loc({error,[42]}),
+ Deep4LocBadmatch = get_deep_4_loc({'=',[a,b]}),
+
Prog = [{'_',[],[{exception_trace}]}],
?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog),
?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog),
@@ -959,8 +963,9 @@ exception_nocatch() ->
{trace,t2,exception_from,{erlang,throw,1},
{error,{nocatch,Q2}}}],
exception_from, {error,{nocatch,Q2}}),
- ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2]},
- {?MODULE,deep_4,1}]}}),
+ ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]},
+ {?MODULE,deep_4,1,
+ Deep4LocThrow}]}}),
?line Q3 = {dump,[dump,{dump}]},
?line T3 =
exception_nocatch(?LINE, error, [Q3], 4,
@@ -968,18 +973,29 @@ exception_nocatch() ->
{trace,t3,exception_from,{erlang,error,1},
{error,Q3}}],
exception_from, {error,Q3}),
- ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3]},
- {?MODULE,deep_4,1}]}}),
+ ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]},
+ {?MODULE,deep_4,1,Deep4LocError}]}}),
?line T4 =
exception_nocatch(?LINE, '=', [17,4711], 5, [],
exception_from, {error,{badmatch,4711}}),
- ?line expect({trace,T4,exit,{{badmatch,4711},[{?MODULE,deep_4,1}]}}),
+ ?line expect({trace,T4,exit,{{badmatch,4711},
+ [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}),
%%
?line erlang:trace_pattern({?MODULE,'_','_'}, false),
?line erlang:trace_pattern({erlang,'_','_'}, false),
?line expect(),
?line ok.
+get_deep_4_loc(Arg) ->
+ try
+ deep_4(Arg),
+ ?t:fail(should_not_return_to_here)
+ catch
+ _:_ ->
+ [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(),
+ Loc0
+ end.
+
exception_nocatch(Line, B, Q, N, Extra, Tag, R) ->
?line io:format("== Subtest: ~w", [Line]),
?line Go = make_ref(),
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 29cbdedd17..2f9b01cc92 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -24,9 +24,10 @@
t_check_process_code/1,t_check_old_code/1,
t_check_process_code_ets/1,
external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
- make_stub_many_funs/1,constant_pools/1,
- false_dependency/1,coverage/1]).
+ make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1,
+ false_dependency/1,coverage/1,fun_confusion/1]).
+-define(line_trace, 1).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -35,15 +36,18 @@ all() ->
[new_binary_types, t_check_process_code,
t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
module_md5, make_stub, make_stub_many_funs,
- constant_pools, false_dependency, coverage].
+ constant_pools, constant_refc_binaries, false_dependency,
+ coverage, fun_confusion].
groups() ->
[].
init_per_suite(Config) ->
+ erts_debug:set_internal_state(available_internal_state, true),
Config.
end_per_suite(_Config) ->
+ catch erts_debug:set_internal_state(available_internal_state, false),
ok.
init_per_group(_GroupName, Config) ->
@@ -278,7 +282,8 @@ t_check_old_code(Config) when is_list(Config) ->
external_fun(Config) when is_list(Config) ->
?line false = erlang:function_exported(another_code_test, x, 1),
- ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1),
+ AnotherCodeTest = id(another_code_test),
+ ExtFun = fun AnotherCodeTest:x/1,
?line {'EXIT',{undef,_}} = (catch ExtFun(answer)),
?line false = erlang:function_exported(another_code_test, x, 1),
?line false = lists:member(another_code_test, erlang:loaded()),
@@ -403,7 +408,7 @@ make_stub_many_funs(Config) when is_list(Config) ->
constant_pools(Config) when is_list(Config) ->
?line Data = ?config(data_dir, Config),
?line File = filename:join(Data, "literals"),
- ?line {ok,literals,Code} = compile:file(File, [report,binary,constant_pool]),
+ ?line {ok,literals,Code} = compile:file(File, [report,binary]),
?line {module,literals} = erlang:load_module(literals,
make_sub_binary(Code)),
@@ -474,6 +479,131 @@ create_old_heap() ->
create_old_heap()
end.
+constant_refc_binaries(Config) when is_list(Config) ->
+ wait_for_memory_deallocations(),
+ Bef = memory_binary(),
+ io:format("Binary data (bytes) before test: ~p\n", [Bef]),
+
+ %% Compile the the literals module.
+ Data = ?config(data_dir, Config),
+ File = filename:join(Data, "literals"),
+ {ok,literals,Code} = compile:file(File, [report,binary]),
+
+ %% Load the code and make sure that the binary is a refc binary.
+ {module,literals} = erlang:load_module(literals, Code),
+ Bin = literals:binary(),
+ Sz = byte_size(Bin),
+ Check = erlang:md5(Bin),
+ io:format("Size of literal refc binary: ~p\n", [Sz]),
+ {refc_binary,Sz,_,_} = erts_debug:get_internal_state({binary_info,Bin}),
+ true = erlang:delete_module(literals),
+ false = erlang:check_process_code(self(), literals),
+ true = erlang:purge_module(literals),
+
+ %% Now try to provoke a memory leak.
+ provoke_mem_leak(10, Code, Check),
+
+ %% Calculate the change in allocated binary data.
+ erlang:garbage_collect(),
+ wait_for_memory_deallocations(),
+ Aft = memory_binary(),
+ io:format("Binary data (bytes) after test: ~p", [Aft]),
+ Diff = Aft - Bef,
+ if
+ Diff < 0 ->
+ io:format("~p less bytes", [abs(Diff)]);
+ Diff > 0 ->
+ io:format("~p more bytes", [Diff]);
+ true ->
+ ok
+ end,
+
+ %% Test for leaks. We must accept some natural variations in
+ %% the size of allocated binaries.
+ if
+ Diff > 64*1024 ->
+ ?t:fail(binary_leak);
+ true ->
+ ok
+ end.
+
+memory_binary() ->
+ try
+ erlang:memory(binary)
+ catch
+ error:notsup ->
+ 0
+ end.
+
+provoke_mem_leak(0, _, _) -> ok;
+provoke_mem_leak(N, Code, Check) ->
+ {module,literals} = erlang:load_module(literals, Code),
+
+ %% Create several processes with references to the literal binary.
+ Self = self(),
+ Pids = [spawn_link(fun() ->
+ create_binaries(Self, NumRefs, Check)
+ end) || NumRefs <- lists:seq(1, 10)],
+ [receive {started,Pid} -> ok end || Pid <- Pids],
+
+ %% Make the code old and remove references to the constant pool
+ %% in all processes.
+ true = erlang:delete_module(literals),
+ Ms = [spawn_monitor(fun() ->
+ false = erlang:check_process_code(Pid, literals)
+ end) || Pid <- Pids],
+ [receive
+ {'DOWN',R,process,P,normal} ->
+ ok
+ end || {P,R} <- Ms],
+
+ %% Purge the code.
+ true = erlang:purge_module(literals),
+
+ %% Tell the processes that the code has been purged.
+ [begin
+ monitor(process, Pid),
+ Pid ! purged
+ end || Pid <- Pids],
+
+ %% Wait for all processes to terminate.
+ [receive
+ {'DOWN',_,process,Pid,normal} ->
+ ok
+ end || Pid <- Pids],
+
+ %% We now expect that the binary has been deallocated.
+ provoke_mem_leak(N-1, Code, Check).
+
+create_binaries(Parent, NumRefs, Check) ->
+ Bin = literals:binary(),
+ Bins = lists:duplicate(NumRefs, Bin),
+ {bits,Bits} = literals:bits(),
+ Parent ! {started,self()},
+ receive
+ purged ->
+ %% The code has been purged. Now make sure that
+ %% the binaries haven't been corrupted.
+ Check = erlang:md5(Bin),
+ [Bin = B || B <- Bins],
+ <<42:13,Bin/binary>> = Bits,
+
+ %% Remove all references to the binaries
+ %% Doing it explicitly like this ensures that
+ %% the binaries are gone when the parent process
+ %% receives the 'DOWN' message.
+ erlang:garbage_collect()
+ end.
+
+wait_for_memory_deallocations() ->
+ try
+ erts_debug:set_internal_state(wait, deallocations)
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_for_memory_deallocations()
+ end.
+
%% OTP-7559: c_p->cp could contain garbage and create a false dependency
%% to a module in a process. (Thanks to Richard Carlsson.)
false_dependency(Config) when is_list(Config) ->
@@ -555,6 +685,30 @@ coverage(Config) when is_list(Config) ->
?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)),
ok.
+fun_confusion(Config) when is_list(Config) ->
+ Data = ?config(data_dir, Config),
+ Src = filename:join(Data, "fun_confusion"),
+ Mod = fun_confusion,
+
+ %% Load first version of module.
+ compile_load(Mod, Src, 1),
+ F1 = Mod:f(),
+ 1 = F1(),
+
+ %% Load second version of module.
+ compile_load(Mod, Src, 2),
+ F2 = Mod:f(),
+
+ %% F1 should refer to the old code, not the newly loaded code.
+ 1 = F1(),
+ 2 = F2(),
+ ok.
+
+compile_load(Mod, Src, Ver) ->
+ {ok,Mod,Code1} = compile:file(Src, [binary,{d,version,Ver}]),
+ {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1),
+ ok.
+
%% Utilities.
make_sub_binary(Bin) when is_binary(Bin) ->
diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl
new file mode 100644
index 0000000000..16000861df
--- /dev/null
+++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl
@@ -0,0 +1,31 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(fun_confusion).
+
+-export([f/0]).
+
+f() ->
+ fun() -> version() end.
+
+version() ->
+ %% Changing the value returned here should change
+ %% the identity of the fun in f/0.
+ ?version.
+
diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl
index 9f99b1a780..d9cb8938db 100644
--- a/erts/emulator/test/code_SUITE_data/literals.erl
+++ b/erts/emulator/test/code_SUITE_data/literals.erl
@@ -18,7 +18,7 @@
%%
-module(literals).
--export([a/0,b/0,huge_bignum/0]).
+-export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]).
a() ->
{a,42.0,[7,38877938333399637266518333334747]}.
@@ -81,3 +81,22 @@ b() ->
huge_bignum() ->
36#9987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987779JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR073737676679877.
+
+-define(TIMES_FOUR(X), X,X,X,X).
+-define(BYTES_256, 0:256,1:256,2:256,3:256, 4:256,5:256,6:256,7:256).
+-define(KB_1, ?TIMES_FOUR(?BYTES_256)).
+-define(KB_4, ?TIMES_FOUR(?KB_1)).
+-define(KB_16, ?TIMES_FOUR(?KB_4)).
+-define(KB_64, ?TIMES_FOUR(?KB_16)).
+-define(KB_128, ?TIMES_FOUR(?KB_64)).
+-define(MB_1, ?TIMES_FOUR(?KB_128)).
+
+binary() ->
+ %% Too big to be a heap binary.
+ <<?MB_1>>.
+
+unused_binaries() ->
+ {<<?KB_128>>,<<?BYTES_256>>}.
+
+bits() ->
+ {bits,<<42:13,?MB_1>>}.
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index 19281f6d58..08308629fe 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -18,7 +18,7 @@
%%
-module(distribution_SUITE).
--compile(r12).
+-compile(r13).
%% Tests distribution and the tcp driver.
@@ -37,7 +37,7 @@
dist_auto_connect_never/1, dist_auto_connect_once/1,
dist_parallel_send/1,
atom_roundtrip/1,
- atom_roundtrip_r12b/1,
+ atom_roundtrip_r13b/1,
contended_atom_cache_entry/1,
bad_dist_structure/1,
bad_dist_ext_receive/1,
@@ -62,7 +62,7 @@ all() ->
link_to_dead_new_node, applied_monitor_node,
ref_port_roundtrip, nil_roundtrip, stop_dist,
{group, trap_bif}, {group, dist_auto_connect},
- dist_parallel_send, atom_roundtrip, atom_roundtrip_r12b,
+ dist_parallel_send, atom_roundtrip, atom_roundtrip_r13b,
contended_atom_cache_entry, bad_dist_structure, {group, bad_dist_ext}].
groups() ->
@@ -1100,17 +1100,17 @@ atom_roundtrip(Config) when is_list(Config) ->
?line stop_node(Node),
?line ok.
-atom_roundtrip_r12b(Config) when is_list(Config) ->
- case ?t:is_release_available("r12b") of
+atom_roundtrip_r13b(Config) when is_list(Config) ->
+ case ?t:is_release_available("r13b") of
true ->
?line AtomData = atom_data(),
?line verify_atom_data(AtomData),
- ?line {ok, Node} = start_node(Config, [], "r12b"),
+ ?line {ok, Node} = start_node(Config, [], "r13b"),
?line do_atom_roundtrip(Node, AtomData),
?line stop_node(Node),
?line ok;
false ->
- ?line {skip,"No OTP R12B available"}
+ ?line {skip,"No OTP R13B available"}
end.
do_atom_roundtrip(Node, AtomData) ->
diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl
index 9d6fc9521d..109cec25cb 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -23,9 +23,10 @@
init_per_group/2,end_per_group/2,
badmatch/1, pending_errors/1, nil_arith/1,
stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1,
- exception_with_heap_frag/1]).
+ exception_with_heap_frag/1, line_numbers/1]).
-export([bad_guy/2]).
+-export([crash/1]).
-include_lib("test_server/include/test_server.hrl").
-import(lists, [foreach/2]).
@@ -35,7 +36,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[badmatch, pending_errors, nil_arith, stacktrace,
nested_stacktrace, raise, gunilla, per,
- exception_with_heap_frag].
+ exception_with_heap_frag, line_numbers].
groups() ->
[].
@@ -141,14 +142,20 @@ pending_exit_message(Args, Expected) ->
end,
process_flag(trap_exit, false).
-pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code)
- when is_atom(Bif), is_list(BifArgs), length(Args) == Arity ->
+pending({badarg,[{erlang,Bif,BifArgs,Loc1},
+ {?MODULE,Func,Arity,Loc2}|_]},
+ Func, Args, _Code)
+ when is_atom(Bif), is_list(BifArgs), length(Args) =:= Arity,
+ is_list(Loc1), is_list(Loc2) ->
ok;
-pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) ->
+pending({undef,[{non_existing_module,foo,[],Loc}|_]}, _, _, _)
+ when is_list(Loc) ->
ok;
-pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) ->
+pending({function_clause,[{?MODULE,Func,Args,Loc}|_]}, Func, Args, _Code)
+ when is_list(Loc) ->
ok;
-pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity ->
+pending({Code,[{?MODULE,Func,Arity,Loc}|_]}, Func, Args, Code)
+ when length(Args) =:= Arity, is_list(Loc) ->
ok;
pending(Reason, _Function, _Args, _Code) ->
test_server:fail({bad_exit_reason,Reason}).
@@ -255,24 +262,24 @@ stacktrace(Conf) when is_list(Conf) ->
?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end),
?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end,
V = [make_ref()|self()],
- ?line {value2,{caught1,badarg,[{erlang,abs,[V]}|_]=St1}} =
+ ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} =
stacktrace_1({'abs',V}, error, {value,V}),
?line St1 = erase(stacktrace1),
?line St1 = erase(stacktrace2),
?line St1 = erlang:get_stacktrace(),
- ?line {caught2,{error,badarith},[{?MODULE,my_add,2}|_]=St2} =
+ ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} =
stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}),
- ?line [{?MODULE,my_div,2}|_] = erase(stacktrace1),
+ ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1),
?line St2 = erase(stacktrace2),
?line St2 = erlang:get_stacktrace(),
- ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3}|_]=St3} =
+ ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} =
stacktrace_1({value,V}, error, {value,V}),
?line St3 = erase(stacktrace1),
?line St3 = erase(stacktrace2),
?line St3 = erlang:get_stacktrace(),
- ?line {caught2,{throw,V},[{?MODULE,foo,1}|_]=St4} =
+ ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} =
stacktrace_1({value,V}, error, {throw,V}),
- ?line [{?MODULE,stacktrace_1,3}|_] = erase(stacktrace1),
+ ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1),
?line St4 = erase(stacktrace2),
?line St4 = erlang:get_stacktrace(),
@@ -280,8 +287,8 @@ stacktrace(Conf) when is_list(Conf) ->
?line stacktrace_2()
catch
error:{badmatch,_} ->
- [{?MODULE,stacktrace_2,0},
- {?MODULE,stacktrace,1}|_] =
+ [{?MODULE,stacktrace_2,0,_},
+ {?MODULE,stacktrace,1,_}|_] =
erlang:get_stacktrace(),
ok
end.
@@ -315,15 +322,15 @@ nested_stacktrace(Conf) when is_list(Conf) ->
nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
{void,void,void}),
?line {caught1,
- [{?MODULE,my_add,2}|_],
+ [{?MODULE,my_add,2,_}|_],
value2,
- [{?MODULE,my_add,2}|_]} =
+ [{?MODULE,my_add,2,_}|_]} =
nested_stacktrace_1({{'add',{V,x1}},error,badarith},
{{value,{V,x2}},void,{V,x2}}),
?line {caught1,
- [{?MODULE,my_add,2}|_],
- {caught2,[{erlang,abs,[V]}|_]},
- [{erlang,abs,[V]}|_]} =
+ [{?MODULE,my_add,2,_}|_],
+ {caught2,[{erlang,abs,[V],_}|_]},
+ [{erlang,abs,[V],_}|_]} =
nested_stacktrace_1({{'add',{V,x1}},error,badarith},
{{'abs',V},error,badarg}),
ok.
@@ -362,14 +369,14 @@ raise(Conf) when is_list(Conf) ->
end,
?line A = erlang:get_stacktrace(),
?line A = get(raise),
- ?line [{?MODULE,my_div,2}|_] = A,
+ ?line [{?MODULE,my_div,2,_}|_] = A,
%%
N = 8, % Must be even
?line N = erlang:system_flag(backtrace_depth, N),
+ ?line B = odd_even(N, []),
?line try even(N)
catch error:function_clause -> ok
end,
- ?line B = odd_even(N, []),
?line B = erlang:get_stacktrace(),
%%
?line C0 = odd_even(N+1, []),
@@ -387,19 +394,12 @@ raise(Conf) when is_list(Conf) ->
odd_even(N, R) when is_integer(N), N > 1 ->
odd_even(N-1,
[if (N rem 2) == 0 ->
- {?MODULE,even,1};
+ {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]};
true ->
- {?MODULE,odd,1}
+ {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]}
end|R]);
odd_even(1, R) ->
- [{?MODULE,odd,[1]}|R].
-
-even(N) when is_integer(N), N > 1, (N rem 2) == 0 ->
- odd(N-1)++[N].
-
-odd(N) when is_integer(N), N > 1, (N rem 2) == 1 ->
- even(N-1)++[N].
-
+ [{?MODULE,odd,[1],[{file,"odd_even.erl"},{line,5}]}|R].
foo({value,Value}) -> Value;
foo({'div',{A,B}}) ->
@@ -526,4 +526,186 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) ->
do_exception_with_heap_frag(Bin, Sizes);
do_exception_with_heap_frag(_, []) -> ok.
+line_numbers(Config) when is_list(Config) ->
+ {'EXIT',{{case_clause,bad_tag},
+ [{?MODULE,line1,2,
+ [{file,"fake_file.erl"},{line,3}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(bad_tag, 0)),
+ {'EXIT',{badarith,
+ [{?MODULE,line1,2,
+ [{file,"fake_file.erl"},{line,5}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(a, not_an_integer)),
+ {'EXIT',{{badmatch,{ok,1}},
+ [{?MODULE,line1,2,
+ [{file,"fake_file.erl"},{line,7}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(a, 0)),
+ {'EXIT',{crash,
+ [{?MODULE,crash,1,
+ [{file,"fake_file.erl"},{line,14}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(a, 41)),
+
+ ModFile = ?MODULE_STRING++".erl",
+ [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]},
+ {?MODULE,call1,0,[{file,"call.erl"},{line,14}]},
+ {?MODULE,close_calls,1,[{file,"call.erl"},{line,5}]},
+ {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] =
+ close_calls(call1),
+ [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]},
+ {?MODULE,call2,0,[{file,"call.erl"},{line,18}]},
+ {?MODULE,close_calls,1,[{file,"call.erl"},{line,6}]},
+ {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] =
+ close_calls(call2),
+ [{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]},
+ {?MODULE,call3,0,[{file,"call.erl"},{line,22}]},
+ {?MODULE,close_calls,1,[{file,"call.erl"},{line,7}]},
+ {?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] =
+ close_calls(call3),
+ no_crash = close_calls(other),
+
+ <<0,0>> = build_binary1(16),
+ {'EXIT',{badarg,
+ [{?MODULE,build_binary1,1,
+ [{file,"bit_syntax.erl"},{line,72503}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary1(bad_size)),
+
+ <<7,1,2,3>> = build_binary2(8, <<1,2,3>>),
+ {'EXIT',{badarg,
+ [{?MODULE,build_binary2,2,
+ [{file,"bit_syntax.erl"},{line,72507}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary2(bad_size, <<>>)),
+ {'EXIT',{badarg,
+ [{erlang,bit_size,[bad_binary],[]},
+ {?MODULE,build_binary2,2,
+ [{file,"bit_syntax.erl"},{line,72507}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary2(8, bad_binary)),
+
+ {'EXIT',{function_clause,
+ [{?MODULE,do_call_abs,[y,y],
+ [{file,"gc_bif.erl"},{line,18}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch do_call_abs(y, y)),
+ {'EXIT',{badarg,
+ [{erlang,abs,[[]],[]},
+ {?MODULE,do_call_abs,2,
+ [{file,"gc_bif.erl"},{line,19}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch do_call_abs(x, [])),
+
+ {'EXIT',{{badmatch,"42"},
+ [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch applied_bif_1(42)),
+
+ {'EXIT',{{badmatch,{current_location,
+ {?MODULE,applied_bif_2,0,
+ [{file,"applied_bif.erl"},{line,9}]}}},
+ [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch applied_bif_2()),
+
+ ok.
+
id(I) -> I.
+
+-file("odd_even.erl", 1). %Line 1
+even(N) when is_integer(N), N > 1, (N rem 2) == 0 ->
+ odd(N-1)++[N]. %Line 3
+
+odd(N) when is_integer(N), N > 1, (N rem 2) == 1 ->
+ even(N-1)++[N]. %Line 6
+
+%%
+%% If the compiler removes redundant line instructions (any
+%% line instruction with the same location as the previous),
+%% and the loader also removes line instructions before
+%% tail-recursive calls to external functions, then the
+%% badmatch exception in line 7 below will be reported as
+%% occurring in line 6.
+%%
+%% That means that any removal of redundant line instructions
+%% must all be done in the compiler OR in the loader.
+%%
+-file("fake_file.erl", 1). %Line 1
+line1(Tag, X) -> %Line 2
+ case Tag of %Line 3
+ a ->
+ Y = X + 1, %Line 5
+ Res = id({ok,Y}), %Line 6
+ ?MODULE:crash({ok,42} = Res); %Line 7
+ b ->
+ x = id(x), %Line 9
+ ok %Line 10
+ end. %Line 11
+
+crash(_) -> %Line 13
+ erlang:error(crash). %Line 14
+
+-file("call.erl", 1). %Line 1
+close_calls(Where) -> %Line 2
+ put(where_to_crash, Where), %Line 3
+ try
+ call1(), %Line 5
+ call2(), %Line 6
+ call3(), %Line 7
+ no_crash %Line 8
+ catch error:crash ->
+ erlang:get_stacktrace() %Line 10
+ end. %Line 11
+
+call1() -> %Line 13
+ maybe_crash(call1), %Line 14
+ ok. %Line 15
+
+call2() -> %Line 17
+ maybe_crash(call2), %Line 18
+ ok. %Line 19
+
+call3() -> %Line 21
+ maybe_crash(call3), %Line 22
+ ok. %Line 23
+
+maybe_crash(Name) -> %Line 25
+ case get(where_to_crash) of %Line 26
+ Name ->
+ erlang:error(crash); %Line 28
+ _ ->
+ ok %Line 30
+ end.
+
+-file("bit_syntax.erl", 72500). %Line 72500
+build_binary1(Size) -> %Line 72501
+ id(42), %Line 72502
+ <<0:Size>>. %Line 72503
+
+build_binary2(Size, Bin) -> %Line 72505
+ id(0), %Line 72506
+ <<7:Size,Bin/binary>>. %Line 72507
+
+-file("gc_bif.erl", 17).
+do_call_abs(x, Arg) -> %Line 18
+ abs(Arg). %Line 19
+
+%% Make sure a BIF that is applied does not leave the p->cp
+%% set (and thus generating an extra entry on the stack).
+
+-file("applied_bif.erl", 1).
+%% Explicit apply.
+applied_bif_1(I) -> %Line 3
+ L = apply(erlang, integer_to_list, [I]), %Line 4
+ fail = L, %Line 5
+ ok. %Line 6
+%% Implicit apply.
+applied_bif_2() -> %Line 8
+ R = process_info(self(), current_location), %Line 9
+ fail = R, %Line 10
+ ok. %Line 11
diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl
index 736510339f..8e6923ce9f 100644
--- a/erts/emulator/test/float_SUITE.erl
+++ b/erts/emulator/test/float_SUITE.erl
@@ -25,8 +25,9 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,
- bad_float_unpack/1]).
+ bad_float_unpack/1,cmp_zero/1, cmp_integer/1, cmp_bignum/1]).
-export([otp_7178/1]).
+-export([hidden_inf/1]).
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
@@ -41,10 +42,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[fpe, fp_drv, fp_drv_thread, otp_7178, denormalized,
- match, bad_float_unpack].
+ match, bad_float_unpack, {group, comparison}
+ ,hidden_inf
+ ].
groups() ->
- [].
+ [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}].
init_per_suite(Config) ->
Config.
@@ -187,6 +190,101 @@ bad_float_unpack(Config) when is_list(Config) ->
bad_float_unpack_match(<<F:64/float>>) -> F;
bad_float_unpack_match(<<I:64/integer-signed>>) -> I.
+cmp_zero(_Config) ->
+ cmp(0.5e-323,0).
+
+cmp_integer(_Config) ->
+ Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise
+ span_cmp(Axis,2,200),
+ cmp(Axis*Axis,round(Axis)).
+
+cmp_bignum(_Config) ->
+ span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float
+
+ %% Test when the big num goes from I to I+1 in size
+ [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)],
+
+ %% Test bignum greater then largest float
+ cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0),
+ %% Test when num is much larger then float
+ [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)],
+ %% Test when float is much larger than num
+ [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)],
+
+ %% Test that all int == float works as they should
+ [true = 1 bsl N == (1 bsl N)*1.0 || N <- lists:seq(0, 1023)],
+ [true = (1 bsl N)*-1 == (1 bsl N)*-1.0 || N <- lists:seq(0, 1023)].
+
+span_cmp(Axis) ->
+ span_cmp(Axis, 25).
+span_cmp(Axis, Length) ->
+ span_cmp(Axis, round(Axis) bsr 52, Length).
+span_cmp(Axis, Incr, Length) ->
+ [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)].
+%% This function creates tests around number axis. Both <, > and == is tested
+%% for both negative and positive numbers.
+%%
+%% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0
+%% Incr: How much to increment the test numbers inbetween each test.
+%% Length: Length/2 is the number of Incr away from Axis to test on the
+%% negative and positive plane.
+%% Diff: How much the float and int should differ when comparing
+span_cmp(Axis, Incr, Length, Diff) ->
+ [begin
+ cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr),
+ cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr)
+ end || I <- lists:seq((Length div 2)*-1,(Length div 2))],
+ [begin
+ cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr),
+ cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr)
+ end || I <- lists:seq((Length div 2)*-1,(Length div 2))].
+
+cmp(Big,Small) when is_float(Big) ->
+ BigGtSmall = lists:flatten(
+ io_lib:format("~f > ~p",[Big,Small])),
+ BigLtSmall = lists:flatten(
+ io_lib:format("~f < ~p",[Big,Small])),
+ BigEqSmall = lists:flatten(
+ io_lib:format("~f == ~p",[Big,Small])),
+ SmallGtBig = lists:flatten(
+ io_lib:format("~p > ~f",[Small,Big])),
+ SmallLtBig = lists:flatten(
+ io_lib:format("~p < ~f",[Small,Big])),
+ SmallEqBig = lists:flatten(
+ io_lib:format("~p == ~f",[Small,Big])),
+ cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
+ SmallEqBig,BigEqSmall);
+cmp(Big,Small) when is_float(Small) ->
+ BigGtSmall = lists:flatten(
+ io_lib:format("~p > ~f",[Big,Small])),
+ BigLtSmall = lists:flatten(
+ io_lib:format("~p < ~f",[Big,Small])),
+ BigEqSmall = lists:flatten(
+ io_lib:format("~p == ~f",[Big,Small])),
+ SmallGtBig = lists:flatten(
+ io_lib:format("~f > ~p",[Small,Big])),
+ SmallLtBig = lists:flatten(
+ io_lib:format("~f < ~p",[Small,Big])),
+ SmallEqBig = lists:flatten(
+ io_lib:format("~f == ~p",[Small,Big])),
+ cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
+ SmallEqBig,BigEqSmall).
+
+cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
+ SmallEqBig,BigEqSmall) ->
+ {_,_,_,true} = {Big,Small,BigGtSmall,
+ Big > Small},
+ {_,_,_,false} = {Big,Small,BigLtSmall,
+ Big < Small},
+ {_,_,_,false} = {Big,Small,SmallGtBig,
+ Small > Big},
+ {_,_,_,true} = {Big,Small,SmallLtBig,
+ Small < Big},
+ {_,_,_,false} = {Big,Small,SmallEqBig,
+ Small == Big},
+ {_,_,_,false} = {Big,Small,BigEqSmall,
+ Big == Small}.
+
id(I) -> I.
start_node(Config) when is_list(Config) ->
@@ -205,3 +303,25 @@ start_node(Config) when is_list(Config) ->
stop_node(Node) ->
?t:stop_node(Node).
+
+
+%% Test that operations that might hide infinite intermediate results
+%% do not supress the badarith.
+hidden_inf(Config) when is_list(Config) ->
+ ZeroP = 0.0,
+ ZeroN = id(ZeroP) * (-1),
+ [hidden_inf_1(A, B, Z, 9.23e307)
+ || A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
+ B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
+ Z <- [ZeroP, ZeroN]],
+ ok.
+
+hidden_inf_1(A, B, Zero, Huge) ->
+ {'EXIT',{badarith,_}} = (catch (B / (A / Zero))),
+ {'EXIT',{badarith,_}} = (catch (B * (A / Zero))),
+ {'EXIT',{badarith,_}} = (catch (B / (Huge * Huge))),
+ {'EXIT',{badarith,_}} = (catch (B * (Huge * Huge))),
+ {'EXIT',{badarith,_}} = (catch (B / (Huge + Huge))),
+ {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))),
+ {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))),
+ {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))).
diff --git a/erts/emulator/test/fun_r12_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl
index 3b1dfc9825..76ddf9fec9 100644
--- a/erts/emulator/test/fun_r12_SUITE.erl
+++ b/erts/emulator/test/fun_r13_SUITE.erl
@@ -17,10 +17,10 @@
%% %CopyrightEnd%
%%
--module(fun_r12_SUITE).
--compile(r12).
+-module(fun_r13_SUITE).
+-compile(r13).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,dist_old_release/1]).
@@ -29,10 +29,10 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[dist_old_release].
-groups() ->
+groups() ->
[].
init_per_suite(Config) ->
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index f41324c2cc..a5df9b59a0 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -421,7 +421,7 @@ try_gbif(Id, X, Y) ->
try_fail_gbif(Id, X, Y) ->
case catch guard_bif(Id, X, Y) of
- {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} ->
+ {'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} ->
io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]);
Other ->
?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
@@ -493,9 +493,9 @@ type_tests(Test, [Type|T], Allowed) ->
end;
false ->
case catch type_test(Test, Value) of
- {'EXIT', {function_clause, {?MODULE,type_test,[Test,Value]}}} ->
- ok;
- {'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} ->
+ {'EXIT',{function_clause,
+ [{?MODULE,type_test,[Test,Value],Loc}|_]}}
+ when is_list(Loc) ->
ok;
{'EXIT',Other} ->
?line test_server:fail({unexpected_error_reason,Other});
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index f6344791f1..370363bf9e 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -35,7 +35,9 @@
resource_takeover/1,
threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1,
is_checks/1,
- get_length/1, make_atom/1, make_string/1]).
+ get_length/1, make_atom/1, make_string/1, reverse_list_test/1,
+ otp_9668/1
+ ]).
-export([many_args_100/100]).
@@ -60,7 +62,9 @@ all() ->
iolist_as_binary, resource, resource_binary,
resource_takeover, threading, send, send2, send3,
send_threaded, neg, is_checks, get_length, make_atom,
- make_string].
+ make_string,reverse_list_test,
+ otp_9668
+ ].
groups() ->
[].
@@ -1165,7 +1169,28 @@ is_checks(Config) when is_list(Config) ->
?line ensure_lib_loaded(Config, 1),
?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
- {hejsan, "hejsan", [$h,"ejs",<<"an">>]}),
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2),
+ ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ self(), hd(erlang:ports()), [], [1,9,9,8],
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2),
try
?line error = check_is_exception(),
?line throw(expected_badarg)
@@ -1208,6 +1233,27 @@ make_string(Config) when is_list(Config) ->
AStringWithAccents = [$E,$r,$l,$a,$n,$g,$ ,16#e4,$r,$ ,$e,$t,$t,$ ,$g,$e,$n,$e,$r,$e,$l,$l,$t,$ ,$p,$r,$o,$g,$r,$a,$m,$s,$p,$r,16#e5,$k],
?line Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}.
+reverse_list_test(Config) ->
+ ?line ensure_lib_loaded(Config, 1),
+ List = lists:seq(1,100),
+ RevList = lists:reverse(List),
+ ?line RevList = reverse_list(List),
+ ?line badarg = reverse_list(foo).
+
+otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"];
+otp_9668(Config) ->
+ ensure_lib_loaded(Config, 1),
+ TmpMem = tmpmem(),
+ IOList = ["This",' ',<<"is">>,' ',[<<"an iolist">>,'.']],
+ otp_9668_nif(IOList),
+
+ <<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>,
+ otp_9668_nif(UnalignedBin),
+
+ ?line verify_tmpmem(TmpMem),
+ ok.
+
+
tmpmem() ->
case erlang:system_info({allocator,temp_alloc}) of
false -> undefined;
@@ -1296,7 +1342,7 @@ get_resource(_,_) -> ?nif_stub.
release_resource(_) -> ?nif_stub.
last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
-check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
+check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
check_is_exception() -> ?nif_stub.
length_test(_,_,_,_,_) -> ?nif_stub.
make_atoms() -> ?nif_stub.
@@ -1314,8 +1360,10 @@ send_blob_thread(_,_,_) -> ?nif_stub.
join_send_thread(_) -> ?nif_stub.
copy_blob(_) -> ?nif_stub.
send_term(_,_) -> ?nif_stub.
+reverse_list(_) -> ?nif_stub.
echo_int(_) -> ?nif_stub.
type_sizes() -> ?nif_stub.
+otp_9668_nif(_) -> ?nif_stub.
nif_stub_error(Line) ->
exit({nif_not_loaded,module,?MODULE,line,Line}).
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 92f1bab8dd..7d7903af25 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -832,6 +832,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER
* argv[7] an empty list
* argv[8] a non-empty list
* argv[9] a tuple
+ * argv[10] a number (small, big integer or float)
*/
static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
@@ -848,6 +849,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
if (!enif_is_list(env, argv[7])) return enif_make_badarg(env);
if (!enif_is_list(env, argv[8])) return enif_make_badarg(env);
if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env);
+ if (!enif_is_number(env, argv[10])) return enif_make_badarg(env);
return ok_atom;
}
@@ -1421,6 +1423,34 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
return enif_make_int(env, ret);
}
+static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {
+ ERL_NIF_TERM rev_list;
+
+ if(!enif_make_reverse_list(env, argv[0], &rev_list))
+ return enif_make_atom(env, "badarg");
+ return rev_list;
+}
+
+static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ /* Inspect in process independent env */
+ ErlNifEnv* myenv = enif_alloc_env();
+ ERL_NIF_TERM mycopy = enif_make_copy(myenv, argv[0]);
+ ErlNifBinary obin, cbin;
+
+ if ((enif_inspect_binary(env, argv[0], &obin)
+ && enif_inspect_binary(myenv, mycopy, &cbin))
+ ||
+ (enif_inspect_iolist_as_binary(env, argv[0], &obin)
+ && enif_inspect_iolist_as_binary(myenv, mycopy, &cbin)))
+ {
+ assert(obin.size == cbin.size);
+ assert(memcmp(obin.data, cbin.data, obin.size) == 0);
+ }
+ enif_free_env(myenv);
+ return atom_ok;
+}
+
static ErlNifFunc nif_funcs[] =
{
{"lib_version", 0, lib_version},
@@ -1447,7 +1477,7 @@ static ErlNifFunc nif_funcs[] =
{"release_resource", 1, release_resource},
{"last_resource_dtor_call", 0, last_resource_dtor_call},
{"make_new_resource", 2, make_new_resource},
- {"check_is", 10, check_is},
+ {"check_is", 11, check_is},
{"check_is_exception", 0, check_is_exception},
{"length_test", 5, length_test},
{"make_atoms", 0, make_atoms},
@@ -1466,8 +1496,10 @@ static ErlNifFunc nif_funcs[] =
{"join_send_thread", 1, join_send_thread},
{"copy_blob", 1, copy_blob},
{"send_term", 2, send_term},
+ {"reverse_list",1, reverse_list},
{"echo_int", 1, echo_int},
- {"type_sizes", 0, type_sizes}
+ {"type_sizes", 0, type_sizes},
+ {"otp_9668_nif", 1, otp_9668_nif}
};
ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload)
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index f68e712268..fdc55a4cc5 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -35,7 +35,7 @@
self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1,
t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1,
exit_and_timeout/1, exit_twice/1,
- t_process_info/1, process_info_other_msg/1,
+ t_process_info/1, process_info_other/1, process_info_other_msg/1,
process_info_other_dist_msg/1,
process_info_2_list/1, process_info_lock_reschedule/1,
process_info_lock_reschedule2/1,
@@ -64,7 +64,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[spawn_with_binaries, t_exit_1, {group, t_exit_2},
trap_exit_badarg, trap_exit_badarg_in_bif,
- t_process_info, process_info_other_msg,
+ t_process_info, process_info_other, process_info_other_msg,
process_info_other_dist_msg, process_info_2_list,
process_info_lock_reschedule,
process_info_lock_reschedule2,
@@ -258,7 +258,9 @@ trap_exit_badarg() ->
?line Pid = fun_spawn(fun() -> bad_guy(kb_128()) end),
?line Garbage = kb_128(),
?line receive
- {'EXIT', Pid, {badarg,[{erlang,abs,[Garbage]},{?MODULE,bad_guy,1}|_]}} ->
+ {'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]),
@@ -410,7 +412,7 @@ etwice_high(Low) ->
exit(Low, first),
exit(Low, second).
-%% Tests the process_info/1 BIF.
+%% 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()),
@@ -418,13 +420,100 @@ t_process_info(Config) when is_list(Config) ->
?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}} =
+ ?line {current_function,{?MODULE,t_process_info,1}} =
process_info(self(), current_function),
+ ?line {current_function,{?MODULE,t_process_info,1}} =
+ apply(erlang, process_info, [self(),current_function]),
+
+ %% current_location and current_stacktrace
+ {Line1,Res1} = {?LINE,process_info(self(), current_location)},
+ verify_loc(Line1, Res1),
+ {Line2,Res2} = {?LINE,apply(erlang, process_info,
+ [self(),current_location])},
+ 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')),
ok.
+pi_stacktrace(Expected0) ->
+ {Line,Res} = {?LINE,erlang:process_info(self(), current_stacktrace)},
+ {current_stacktrace,Stack} = Res,
+ Expected = [{?MODULE,pi_stacktrace,1,Line}|Expected0],
+ pi_stacktrace_1(Stack, Expected).
+
+pi_stacktrace_1([{M,F,A,Loc}|Stk], [{M,F,A,Line}|Exp]) ->
+ case Loc of
+ [] ->
+ %% No location info for some reason (+L, native code).
+ io:format("Missing location information for ~w:~w/~w",
+ [M,F,A]),
+ ok;
+ [_|_] ->
+ Line = proplists:get_value(line, Loc),
+ File = proplists:get_value(file, Loc),
+ File = ?MODULE_STRING ++ ".erl"
+ end,
+ pi_stacktrace_1(Stk, Exp);
+pi_stacktrace_1([_|_], []) -> ok.
+
+verify_loc(Line, {current_location,{?MODULE,t_process_info=F,1=A,Loc}}) ->
+ case Loc of
+ [] ->
+ %% No location info for some reason (+L, native code).
+ io:format("Missing location information for ~w:~w/~w",
+ [?MODULE,F,A]),
+ ok;
+ [_|_] ->
+ Line = proplists:get_value(line, Loc),
+ File = proplists:get_value(file, Loc),
+ File = ?MODULE_STRING ++ ".erl"
+ end.
+
+process_info_other(Config) when is_list(Config) ->
+ Self = self(),
+ Pid = spawn_link(fun() -> process_info_looper(Self) end),
+ receive after 1 -> ok end,
+ pio_current_location(10000, Pid, 0, 0),
+ pio_current_stacktrace().
+
+pio_current_location(0, _, Pi, Looper) ->
+ io:format("~w call(s) to erlang:process_info/2", [Pi]),
+ io:format("~w call(s) to ~w:process_info_looper/1", [Looper,?MODULE]);
+pio_current_location(N, Pid, Pi, Looper) ->
+ erlang:yield(),
+ {current_location,Where} = process_info(Pid, current_location),
+ case Where of
+ {erlang,process_info,2,[]} ->
+ pio_current_location(N-1, Pid, Pi+1, Looper);
+ {?MODULE,process_info_looper,1,Loc} when is_list(Loc) ->
+ pio_current_location(N-1, Pid, Pi, Looper+1)
+ end.
+
+pio_current_stacktrace() ->
+ L = [begin
+ {current_stacktrace,Stk} = process_info(P, current_stacktrace),
+ {P,Stk}
+ end || P <- processes()],
+ [erlang:garbage_collect(P) || {P,_} <- L],
+ erlang:garbage_collect(),
+ [verify_stacktrace(Stk) || {_,Stk} <- L],
+ ok.
+
+verify_stacktrace([{M,F,A,Loc}|T])
+ when is_atom(M),
+ is_atom(F),
+ is_integer(A),
+ is_list(Loc) ->
+ verify_stacktrace(T);
+verify_stacktrace([]) -> ok.
+
+process_info_looper(Parent) ->
+ process_info(Parent, current_location),
+ 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(),
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 091e960610..32e2a98e3c 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -767,8 +767,8 @@ exception_test(Opts, Func0, Args0) ->
end,
?line R1 = exc_slave(ExcOpts, Func, Args),
- ?line Stack2 = [{?MODULE,exc_top,3},{?MODULE,slave,2}],
- ?line Stack3 = [{?MODULE,exc,2}|Stack2],
+ ?line Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}],
+ ?line Stack3 = [{?MODULE,exc,2,[]}|Stack2],
?line Rs =
case x_exc_top(ExcOpts, Func, Args) of % Emulation
{crash,{Reason,Stack}}=R when is_list(Stack) ->
@@ -789,21 +789,29 @@ exception_test(Opts, Func0, Args0) ->
end,
?line expect({nm}).
-exception_validate(R1, [R2|Rs]) ->
+exception_validate(R0, Rs0) ->
+ R = clean_location(R0),
+ Rs = [clean_location(E) || E <- Rs0],
+ exception_validate_1(R, Rs).
+
+exception_validate_1(R1, [R2|Rs]) ->
case [R1|R2] of
[R|R] ->
ok;
- [{crash,{badarg,[{lists,reverse,[L1a,L1b]}|T]}}|
- {crash,{badarg,[{lists,reverse,[L2a,L2b]}|T]}}] ->
+ [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}|
+ {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] ->
same({crash,{badarg,[{lists,reverse,
- [lists:reverse(L1b, L1a),[]]}|T]}},
+ [lists:reverse(L1b, L1a),[]],[]}|T]}},
{crash,{badarg,[{lists,reverse,
- [lists:reverse(L2b, L2a),[]]}|T]}});
+ [lists:reverse(L2b, L2a),[]],[]}|T]}});
_ when is_list(Rs), Rs =/= [] ->
exception_validate(R1, Rs)
end.
-
+clean_location({crash,{Reason,Stk0}}) ->
+ Stk = [{M,F,A,[]} || {M,F,A,_} <- Stk0],
+ {crash,{Reason,Stk}};
+clean_location(Term) -> Term.
%%% Tracee target functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
@@ -1057,10 +1065,10 @@ x_exc_exception(_Rtt, M, F, _, Arity, CR) ->
x_exc_stacktrace() ->
x_exc_stacktrace(erlang:get_stacktrace()).
%% Truncate stacktrace to below exc/2
-x_exc_stacktrace([{?MODULE,x_exc,4}|_]) -> [];
-x_exc_stacktrace([{?MODULE,x_exc_func,4}|_]) -> [];
-x_exc_stacktrace([{?MODULE,x_exc_body,4}|_]) -> [];
-x_exc_stacktrace([{?MODULE,exc,2}|_]) -> [];
+x_exc_stacktrace([{?MODULE,x_exc,4,_}|_]) -> [];
+x_exc_stacktrace([{?MODULE,x_exc_func,4,_}|_]) -> [];
+x_exc_stacktrace([{?MODULE,x_exc_body,4,_}|_]) -> [];
+x_exc_stacktrace([{?MODULE,exc,2,_}|_]) -> [];
x_exc_stacktrace([H|T]) ->
[H|x_exc_stacktrace(T)].
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index ebf7db3277..58c36c3bdc 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -105,7 +105,9 @@ my %match_engine_ops; # All opcodes for the match engine.
my %gen_transform_offset;
my @transformations;
my @call_table;
+my %call_table;
my @pred_table;
+my %pred_table;
# Operand types for generic instructions.
@@ -187,6 +189,12 @@ sub define_type_bit {
}
#
+# Pre-define the 'fail' instruction. It is used internally
+# by the 'try_me_else_fail' instruction.
+#
+$match_engine_ops{'TOP_fail'} = 1;
+
+#
# Sanity checks.
#
@@ -1304,7 +1312,8 @@ sub tr_gen {
foreach $ref (@g) {
my($line, $orig_transform, $from_ref, $to_ref) = @$ref;
- my $so_far = tr_gen_from($line, @$from_ref);
+ my $used_ref = used_vars($from_ref, $to_ref);
+ my $so_far = tr_gen_from($line, $used_ref, @$from_ref);
tr_gen_to($line, $orig_transform, $so_far, @$to_ref);
}
@@ -1313,9 +1322,22 @@ sub tr_gen {
#
my($offset) = 0;
print "Uint op_transform[] = {\n";
- foreach $key (keys %gen_transform) {
+ foreach $key (sort keys %gen_transform) {
$gen_transform_offset{$key} = $offset;
- foreach $instr (@{$gen_transform{$key}}) {
+ my @instr = @{$gen_transform{$key}};
+
+ #
+ # If the last instruction is 'fail', remove it and
+ # convert the previous 'try_me_else' to 'try_me_else_fail'.
+ #
+ if (is_instr($instr[$#instr], 'fail')) {
+ pop(@instr);
+ my $i = $#instr;
+ $i-- while !is_instr($instr[$i], 'try_me_else');
+ $instr[$i] = make_op('', 'try_me_else_fail');
+ }
+
+ foreach $instr (@instr) {
my($size, $instr_ref, $comment) = @$instr;
my($op, @args) = @$instr_ref;
print " ";
@@ -1342,8 +1364,48 @@ sub tr_gen {
print "};\n\n";
}
+sub used_vars {
+ my($from_ref,$to_ref) = @_;
+ my %used;
+ my %seen;
+
+ foreach my $ref (@$from_ref) {
+ my($name,$arity,@ops) = @$ref;
+ if ($name =~ /^[.]/) {
+ foreach my $var (@ops) {
+ $used{$var} = 1;
+ }
+ } else {
+ # Any variable that is used at least twice on the
+ # left-hand side is used. (E.g. "move R R".)
+ foreach my $op (@ops) {
+ my($var, $type, $type_val) = @$op;
+ next if $var eq '';
+ $used{$var} = 1 if $seen{$var};
+ $seen{$var} = 1;
+ }
+ }
+ }
+
+ foreach my $ref (@$to_ref) {
+ my($name, $arity, @ops) = @$ref;
+ if ($name =~ /^[.]/) {
+ foreach my $var (@ops) {
+ $used{$var} = 1;
+ }
+ } else {
+ foreach my $op (@ops) {
+ my($var, $type, $type_val) = @$op;
+ next if $var eq '';
+ $used{$var} = 1;
+ }
+ }
+ }
+ \%used;
+}
+
sub tr_gen_from {
- my($line, @tr) = @_;
+ my($line,$used_ref,@tr) = @_;
my(%var) = ();
my(%var_type);
my($var_num) = 0;
@@ -1353,25 +1415,30 @@ sub tr_gen_from {
my(@fix_pred_funcs);
my($op, $ref); # Loop variables.
my $where = "left side of transformation in line $line: ";
+ my %var_used = %$used_ref;
+ my $may_fail = 0;
+ my $is_first = 1;
foreach $ref (@tr) {
my($name, $arity, @ops) = @$ref;
my($key) = "$name/$arity";
my($opnum);
+ $may_fail = 1 unless $is_first;
+ $is_first = 0;
+
#
# A name starting with a period is a C pred function to be called.
#
if ($name =~ /^\.(\w+)/) {
$name = $1;
+ $may_fail = 1;
my $var;
my(@args);
- my $next_instr = pop(@code); # Get rid of 'next_instr'
push(@fix_pred_funcs, scalar(@code));
push(@code, [$name, @ops]);
- push(@code, $next_instr);
next;
}
@@ -1383,17 +1450,21 @@ sub tr_gen_from {
unless defined $gen_opnum{$name,$arity};
$opnum = $gen_opnum{$name,$arity};
- push(@code, &make_op("$name/$arity", 'is_op', $opnum));
+ push(@code, make_op("$name/$arity", 'next_instr', $opnum));
$min_window++;
foreach $op (@ops) {
my($var, $type, $type_val, $cond, $val) = @$op;
+ my $ignored_var = "$var (ignored)";
if ($type ne '' && $type ne '*') {
+ $may_fail = 1;
+
#
# The is_bif, is_not_bif, and is_func instructions have
# their own built-in type test and don't need to
# be guarded with a type test instruction.
#
+ $ignored_var = '';
unless ($cond eq 'is_bif' or
$cond eq 'is_not_bif' or
$cond eq 'is_func') {
@@ -1407,7 +1478,7 @@ sub tr_gen_from {
push(@code, &make_op($types, 'is_type', $type_mask));
} else {
$cond = '';
- push(@code, &make_op($types, 'is_type_eq',
+ push(@code, &make_op("$types== $val", 'is_type_eq',
$type_mask, $val));
}
}
@@ -1415,46 +1486,55 @@ sub tr_gen_from {
if ($cond eq 'is_func') {
my($m, $f, $a) = split(/:/, $val);
+ $ignored_var = '';
+ $may_fail = 1;
push(@code, &make_op('', "$cond", "am_$m",
"am_$f", $a));
} elsif ($cond ne '') {
+ $ignored_var = '';
+ $may_fail = 1;
push(@code, &make_op('', "$cond", $val));
}
if ($var ne '') {
if (defined $var{$var}) {
+ $ignored_var = '';
+ $may_fail = 1;
push(@code, &make_op($var, 'is_same_var', $var{$var}));
} elsif ($type eq '*') {
#
# Reserve a hole for a 'rest_args' instruction.
#
+ $ignored_var = '';
push(@fix_rest_args, scalar(@code));
push(@code, $var);
- } else {
+ } elsif ($var_used{$var}) {
+ $ignored_var = '';
$var_type{$var} = 'scalar';
$var{$var} = $var_num;
$var_num++;
push(@code, &make_op($var, 'set_var', $var{$var}));
}
}
- if (is_set_var_instr($code[$#code])) {
+ if (is_instr($code[$#code], 'set_var')) {
my $ref = pop @code;
my $comment = $ref->[2];
my $var = $ref->[1][1];
push(@code, make_op($comment, 'set_var_next_arg', $var));
} else {
- push(@code, &make_op('', 'next_arg'));
+ push(@code, &make_op($ignored_var, 'next_arg'));
}
}
- push(@code, &make_op('', 'next_instr'));
- pop(@code) if $code[$#code]->[1][0] eq 'next_arg';
+
+ # Remove redundant 'next_arg' instructions before the end
+ # of the instruction.
+ pop(@code) while is_instr($code[$#code], 'next_arg');
}
#
# Insert the commit operation.
#
- pop(@code); # Get rid of 'next_instr'
- push(@code, &make_op('', 'commit'));
+ push(@code, make_op($may_fail ? '' : 'always reached', 'commit'));
#
# If there is an rest_args instruction, we must insert its correct
@@ -1484,9 +1564,8 @@ sub tr_gen_from {
push(@args, "var+$var{$var}");
}
}
- splice(@code, $index, 1, &make_op("$name()",
- 'pred', scalar(@pred_table)));
- push(@pred_table, [$name, @args]);
+ my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args);
+ splice(@code, $index, 1, make_op("$name()", 'pred', $pi));
}
$te_max_vars = $var_num
@@ -1503,6 +1582,10 @@ sub tr_gen_to {
my($op, $ref); # Loop variables.
my($where) = "right side of transformation in line $line: ";
+ my $last_instr = $code[$#code];
+ my $cannot_fail = is_instr($last_instr, 'commit') &&
+ (get_comment($last_instr) =~ /^always/);
+
foreach $ref (@tr) {
my($name, $arity, @ops) = @$ref;
@@ -1524,9 +1607,10 @@ sub tr_gen_to {
push(@args, "var+$var{$var}");
}
}
- pop(@code); # Get rid of 'next_instr'
- push(@code, &make_op("$name()", 'call', scalar(@call_table)));
- push(@call_table, [$name, @args]);
+ pop(@code); # Get rid of 'commit' instruction
+ my $index = tr_next_index(\@call_table, \%call_table,
+ $name, @args);
+ push(@code, make_op("$name()", 'call_end', $index));
last;
}
@@ -1543,27 +1627,27 @@ sub tr_gen_to {
# Create code to build the generic instruction.
#
- push(@code, &make_op('', 'new_instr'));
- push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity));
+ push(@code, make_op("$name/$arity", 'new_instr', $opnum));
foreach $op (@ops) {
my($var, $type, $type_val) = @$op;
if ($var ne '') {
&error($where, "variable '$var' unbound")
unless defined $var{$var};
- push(@code, &make_op($var, 'store_var', $var{$var}));
+ push(@code, &make_op($var, 'store_var_next_arg', $var{$var}));
} elsif ($type ne '') {
push(@code, &make_op('', 'store_type', "TAG_$type"));
if ($type_val) {
push(@code, &make_op('', 'store_val', $type_val));
}
+ push(@code, make_op('', 'next_arg'));
}
- push(@code, &make_op('', 'next_arg'));
}
- pop(@code) if $code[$#code]->[1][0] eq 'next_arg';
+ pop(@code) if is_instr($code[$#code], 'next_arg');
}
- push(@code, &make_op('', 'end'));
+ push(@code, make_op('', 'end'))
+ unless is_instr($code[$#code], 'call_end');
#
# Chain together all codes segments having the same first operation.
@@ -1575,11 +1659,20 @@ sub tr_gen_to {
$min_window{$key} = $min_window
if $min_window{$key} > $min_window;
- pop(@{$gen_transform{$key}})
+ my $prev_last;
+ $prev_last = pop(@{$gen_transform{$key}})
if defined @{$gen_transform{$key}}; # Fail
- my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code)));
- unshift(@code, @prefix);
- push(@{$gen_transform{$key}}, @code, &make_op('', 'fail'));
+
+ if ($prev_last && !is_instr($prev_last, 'fail')) {
+ error("Line $line: A previous transformation shadows '$orig_transform'");
+ }
+ unless ($cannot_fail) {
+ unshift(@code, make_op('', 'try_me_else',
+ tr_code_len(@code)));
+ push(@code, make_op(""), make_op("$key", 'fail'));
+ }
+ unshift(@code, make_op($comment));
+ push(@{$gen_transform{$key}}, @code),
}
sub tr_code_len {
@@ -1597,21 +1690,38 @@ sub make_op {
[scalar(@op), [@op], $comment];
}
-sub is_set_var_instr {
- my($ref) = @_;
+sub is_instr {
+ my($ref,$op) = @_;
return 0 unless ref($ref) eq 'ARRAY';
- $ref->[1][0] eq 'set_var';
+ $ref->[1][0] eq $op;
+}
+
+sub get_comment {
+ my($ref,$op) = @_;
+ return '' unless ref($ref) eq 'ARRAY';
+ $ref->[2];
+}
+
+sub tr_next_index {
+ my($lref,$href,$name,@args) = @_;
+ my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n";
+ my $index;
+
+ if (defined $$href{$code}) {
+ $index = $$href{$code};
+ } else {
+ $index = scalar(@$lref);
+ push(@$lref, $code);
+ $$href{$code} = $index;
+ }
+ $index;
}
sub tr_gen_call {
my(@call_table) = @_;
my($i);
- print "\n";
for ($i = 0; $i < @call_table; $i++) {
- my $ref = $call_table[$i];
- my($name, @args) = @$ref;
- print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n";
+ print "case $i: $call_table[$i]";
}
- print "\n";
}
diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload
index d0671e998d..d22f08f993 100755
--- a/erts/emulator/utils/make_preload
+++ b/erts/emulator/utils/make_preload
@@ -88,6 +88,7 @@ foreach $file (@ARGV) {
print "unsigned char preloaded_$module", "[] = {\n";
for ($i = 0; $i < length($_); $i++) {
if ($i % 8 == 0 && $comment ne '') {
+ $comment =~ s@/\*@..@g; # Comment start -- avoid warning.
$comment =~ s@\*/@..@g; # Comment terminator.
print " /* $comment */\n ";
$comment = '';
diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables
index 918ef62094..91efb4c023 100755
--- a/erts/emulator/utils/make_tables
+++ b/erts/emulator/utils/make_tables
@@ -181,8 +181,7 @@ for ($i = 0; $i < @bif; $i++) {
print "\n";
for ($i = 0; $i < @bif; $i++) {
- my $arity = $bif[$i]->[2];
- my $args = join(', ', 'Process*', ('Eterm') x $arity);
+ my $args = join(', ', 'Process*', 'Eterm*');
print "Eterm $bif[$i]->[3]($args);\n";
print "Eterm wrap_$bif[$i]->[3]($args, UWord *I);\n";
}
@@ -219,28 +218,10 @@ for ($i = 0; $i < @bif; $i++) {
next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs
my $arity = $bif[$i]->[2];
my $func = $bif[$i]->[3];
- my $arg;
print "Eterm\n";
- print "wrap_$func(Process* p";
- for ($arg = 1; $arg <= $arity; $arg++) {
- print ", Eterm arg$arg";
- }
- print ", UWord *I)\n";
+ print "wrap_$func(Process* p, Eterm* args, UWord* I)\n";
print "{\n";
- print " return erts_bif_trace($i, p";
- for ($arg = 1; $arg <= 3; $arg++) {
- if ($arg <= $arity) {
- print ", arg$arg";
- #} elsif ($arg == ($arity + 1)) {
- # # Place I in correct position
- # print ", (Eterm) I";
- } else {
- print ", 0";
- }
- }
- # I is always last, as well as in the correct position
- # Note that "last" and "correct position" may be the same...
- print ", I);\n";
+ print " return erts_bif_trace($i, p, args, I);\n";
print "}\n\n";
}
@@ -261,19 +242,9 @@ for ($i = 0; $i < @bif; $i++) {
my $orig_func = $1;
$orig_func = $implementation[$i] if $implementation[$i];
print "Eterm\n";
- print "$func(Process* p";
- for ($arg = 1; $arg <= $arity; $arg++) {
- print ", Eterm arg$arg";
- }
- print ")\n";
+ print "$func(Process* p, Eterm* BIF__ARGS)\n";
print "{\n";
- print " return $orig_func(p";
- for ($arg = 1; $arg <= 3; $arg++) {
- if ($arg <= $arity) {
- print ", arg$arg";
- }
- }
- print ");\n";
+ print " return $orig_func(p, BIF__ARGS);\n";
print "}\n\n";
}
diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0
new file mode 100644
index 0000000000..8cf4cba2c8
--- /dev/null
+++ b/erts/emulator/valgrind/suppress.patched.3.6.0
@@ -0,0 +1,350 @@
+# Valgrind suppression file updated to support the patched
+# Valgrind used in daily builds on ahmed.
+
+{
+ libc internal error
+ Memcheck:Addr8
+ obj:/lib64/ld-2.3.5.so
+}
+{
+ libc internal error
+ Memcheck:Addr8
+ fun:_dl_start
+}
+{
+ libc internal error
+ Memcheck:Addr8
+ fun:__libc_start_main
+ obj:*
+}
+{
+ libc internal error
+ Memcheck:Addr4
+ fun:__sigjmp_save
+ fun:__libc_start_main
+ obj:*
+}
+{
+ libc internal error
+ Memcheck:Addr8
+ fun:__sigsetjmp
+ fun:__libc_start_main
+ obj:*
+}
+{
+ Intentional error in testcase
+ Memcheck:Param
+ pipe(filedes)
+ fun:pipe
+ fun:chkio_drv_timeout
+}
+{
+ Intentional error in testcase
+ Memcheck:Param
+ pipe(filedes)
+ fun:pipe
+ fun:io_ready_exit_drv_control
+ fun:erts_port_control
+ fun:port_control_3
+ fun:process_main
+}
+{
+ Leak in libc putenv
+ Memcheck:Leak
+ fun:malloc
+ fun:realloc
+ fun:__add_to_environ
+ fun:putenv
+ fun:erts_sys_putenv
+ fun:os_putenv_2
+ fun:process_main
+}
+{
+Leak in libc putenv
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:erts_sys_putenv
+fun:os_putenv_2
+fun:process_main
+}
+{
+ erronous warning
+ Memcheck:Leak
+ fun:malloc
+ fun:erts_sys_alloc
+ ...
+ fun:fix_core_alloc
+ fun:erts_init_fix_alloc
+ fun:erts_alloc_init
+ fun:early_init
+ fun:erl_start
+}
+{
+ pthread internal error
+ Memcheck:Param
+ futex(utime)
+ fun:__lll_mutex_unlock_wake
+}
+{
+ libc internal error
+ Memcheck:Param
+ socketcall.sendto(msg)
+ ...
+ fun:getifaddrs
+}
+{
+inet_drv; pointer inside allocated block
+Memcheck:Leak
+PossiblyLost
+fun:realloc
+fun:erts_sys_realloc
+...
+fun:erts_realloc_fnf
+fun:erts_bin_realloc_fnf
+fun:driver_realloc_binary
+}
+{
+inet_drv; pointer inside allocated block
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc_fnf
+fun:erts_bin_drv_alloc_fnf
+fun:driver_alloc_binary
+}
+{
+pthread leak or erroneous valgrind warning
+Memcheck:Leak
+fun:calloc
+fun:allocate_dtv
+fun:_dl_allocate_tls
+fun:pthread_create@@GLIBC_2.2.5
+}
+{
+pthread leak or erroneous valgrind warning
+Memcheck:Leak
+fun:calloc
+fun:_dl_allocate_tls
+fun:pthread_create@@GLIBC_2.2.5
+}
+{
+zlib; ok according to zlib developers
+Memcheck:Cond
+fun:longest_match
+fun:deflate_slow
+fun:deflate
+}
+{
+zlib; ok according to zlib developers
+Memcheck:Cond
+fun:longest_match
+fun:deflate_fast
+fun:deflate
+}
+{
+zlib; ok accordnig to zlib (this one popped up with valgrind-3.6.0)
+Memcheck:Cond
+fun:deflate_slow
+fun:deflate
+fun:zlib_deflate
+fun:zlib_ctl
+}
+{
+No leak; pointer into block
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:erts_init_scheduling
+fun:erl_init
+fun:erl_start
+fun:main
+}
+{
+No leak; pointer into block
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:init_db
+fun:erl_init
+fun:erl_start
+fun:main
+}
+{
+No leak; sometimes pointer into block
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc_fnf
+fun:driver_alloc
+fun:get_bufstk
+fun:alloc_buffer
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/crypto.valgrind.*
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/libcrypto.*
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/openssl.*
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/ssleay.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/crypto.valgrind.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/libcrypto.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/openssl.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/ssleay.*
+}
+{
+ Crypto internal...
+ Memcheck:Cond
+ fun:memset
+ fun:BN_lshift
+ fun:BN_div
+ fun:BN_MONT_CTX_set
+ fun:BN_is_prime_fasttest_ex
+ fun:BN_generate_prime_ex
+ fun:DH_generate_parameters_ex
+ fun:DH_generate_parameters
+ fun:dh_generate_parameters_nif
+ fun:process_main
+ fun:sched_thread_func
+ fun:thr_wrapper
+}
+{
+ Crypto internal...
+ Memcheck:Cond
+ fun:memset
+ fun:BN_lshift
+ fun:BN_div
+ fun:BN_nnmod
+ fun:BN_mod_inverse
+ fun:BN_MONT_CTX_set
+ fun:BN_is_prime_fasttest_ex
+ fun:BN_generate_prime_ex
+ fun:DH_generate_parameters_ex
+ fun:DH_generate_parameters
+ fun:dh_generate_parameters_nif
+ fun:process_main
+}
+{
+ Crypto internal...
+ Memcheck:Value8
+ fun:BN_mod_exp_mont_consttime
+ fun:generate_key
+ fun:dh_generate_key_nif
+ fun:process_main
+ fun:sched_thread_func
+ fun:thr_wrapper
+ fun:start_thread
+ fun:clone
+}
+
+{
+erts_bits_init_state; Why is this needed?
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:erts_bits_init_state
+fun:erts_init_scheduling
+fun:erl_init
+fun:erl_start
+fun:main
+}
+
+{
+Prebuilt constant terms in os_info_init
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:os_info_init
+fun:erts_bif_info_init
+fun:erl_init
+fun:erl_start
+fun:main
+}
+
+{
+Permanent cache aligned malloc for array of mseg allocators
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_mseg_init
+fun:erts_alloc_init
+fun:early_init
+fun:erl_start
+fun:main
+}
+
+{
+Early permanent cache aligned erl_process:aux_work_tmo
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:aux_work_timeout_early_init
+fun:erts_early_init_scheduling
+fun:early_init
+fun:erl_start
+fun:main
+}
+
+{
+Early permanent cache aligned ts_event_pool
+Memcheck:Leak
+PossiblyLost
+fun:malloc
+fun:erts_sys_alloc
+fun:erts_alloc_fnf
+fun:ethr_std_alloc
+fun:ts_event_pool
+fun:init_ts_event_alloc
+fun:ethr_late_init_common__
+fun:ethr_late_init
+fun:erts_thr_late_init
+fun:early_init
+fun:erl_start
+fun:main
+}
+
diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard
new file mode 100644
index 0000000000..26e34e3757
--- /dev/null
+++ b/erts/emulator/valgrind/suppress.standard
@@ -0,0 +1,308 @@
+{
+ libc internal error
+ Memcheck:Addr8
+ obj:/lib64/ld-2.3.5.so
+}
+{
+ libc internal error
+ Memcheck:Addr8
+ fun:_dl_start
+}
+{
+ libc internal error
+ Memcheck:Addr8
+ fun:__libc_start_main
+ obj:*
+}
+{
+ libc internal error
+ Memcheck:Addr4
+ fun:__sigjmp_save
+ fun:__libc_start_main
+ obj:*
+}
+{
+ libc internal error
+ Memcheck:Addr8
+ fun:__sigsetjmp
+ fun:__libc_start_main
+ obj:*
+}
+{
+ Intentional error in testcase
+ Memcheck:Param
+ pipe(filedes)
+ fun:pipe
+ fun:chkio_drv_timeout
+}
+{
+ Intentional error in testcase
+ Memcheck:Param
+ pipe(filedes)
+ fun:pipe
+ fun:io_ready_exit_drv_control
+ fun:erts_port_control
+ fun:port_control_3
+ fun:process_main
+}
+{
+ Leak in libc putenv
+ Memcheck:Leak
+ fun:malloc
+ fun:realloc
+ fun:__add_to_environ
+ fun:putenv
+ fun:erts_sys_putenv
+ fun:os_putenv_2
+ fun:process_main
+}
+{
+Leak in libc putenv
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:erts_sys_putenv
+fun:os_putenv_2
+fun:process_main
+}
+{
+ erronous warning
+ Memcheck:Leak
+ fun:malloc
+ fun:erts_sys_alloc
+ fun:fix_core_alloc
+ fun:erts_init_fix_alloc
+ fun:erts_alloc_init
+ fun:early_init
+ fun:erl_start
+}
+{
+ pthread internal error
+ Memcheck:Param
+ futex(utime)
+ fun:__lll_mutex_unlock_wake
+}
+{
+ libc internal error
+ Memcheck:Param
+ socketcall.sendto(msg)
+ ...
+ fun:getifaddrs
+}
+{
+inet_drv; pointer inside allocated block
+Memcheck:Leak
+fun:realloc
+fun:erts_sys_realloc
+...
+fun:erts_realloc_fnf
+fun:erts_bin_realloc_fnf
+fun:driver_realloc_binary
+}
+{
+inet_drv; pointer inside allocated block
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc_fnf
+fun:erts_bin_drv_alloc_fnf
+fun:driver_alloc_binary
+}
+{
+pthread leak or erroneous valgrind warning
+Memcheck:Leak
+fun:calloc
+fun:allocate_dtv
+fun:_dl_allocate_tls
+fun:pthread_create@@GLIBC_2.2.5
+}
+{
+zlib; ok according to zlib developers
+Memcheck:Cond
+fun:longest_match
+fun:deflate_slow
+fun:deflate
+}
+{
+zlib; ok according to zlib developers
+Memcheck:Cond
+fun:longest_match
+fun:deflate_fast
+fun:deflate
+}
+{
+No leak; pointer into block
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:erts_init_scheduling
+fun:erl_init
+fun:erl_start
+fun:main
+}
+{
+No leak; pointer into block
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:init_db
+fun:erl_init
+fun:erl_start
+fun:main
+}
+{
+No leak; sometimes pointer into block
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc_fnf
+fun:driver_alloc
+fun:get_bufstk
+fun:alloc_buffer
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/crypto.valgrind.*
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/libcrypto.*
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/openssl.*
+}
+{
+ Crypto internal...
+Memcheck:Cond
+obj:*/ssleay.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/crypto.valgrind.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/libcrypto.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/openssl.*
+}
+{
+ Crypto internal...
+Memcheck:Value8
+obj:*/ssleay.*
+}
+{
+ Crypto internal...
+ Memcheck:Cond
+ fun:memset
+ fun:BN_lshift
+ fun:BN_div
+ fun:BN_MONT_CTX_set
+ fun:BN_is_prime_fasttest_ex
+ fun:BN_generate_prime_ex
+ fun:DH_generate_parameters_ex
+ fun:DH_generate_parameters
+ fun:dh_generate_parameters_nif
+ fun:process_main
+ fun:sched_thread_func
+ fun:thr_wrapper
+}
+{
+ Crypto internal...
+ Memcheck:Cond
+ fun:memset
+ fun:BN_lshift
+ fun:BN_div
+ fun:BN_nnmod
+ fun:BN_mod_inverse
+ fun:BN_MONT_CTX_set
+ fun:BN_is_prime_fasttest_ex
+ fun:BN_generate_prime_ex
+ fun:DH_generate_parameters_ex
+ fun:DH_generate_parameters
+ fun:dh_generate_parameters_nif
+ fun:process_main
+}
+{
+ Crypto internal...
+ Memcheck:Value8
+ fun:BN_mod_exp_mont_consttime
+ fun:generate_key
+ fun:dh_generate_key_nif
+ fun:process_main
+ fun:sched_thread_func
+ fun:thr_wrapper
+ fun:start_thread
+ fun:clone
+}
+
+{
+Prebuilt constant terms in os_info_init (PossiblyLost)
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+...
+fun:erts_alloc
+fun:os_info_init
+fun:erts_bif_info_init
+fun:erl_init
+fun:erl_start
+fun:main
+}
+
+{
+Permanent cache aligned malloc for array of mseg allocators
+Memcheck:Leak
+fun:malloc
+fun:erts_mseg_init
+fun:erts_alloc_init
+fun:early_init
+fun:erl_start
+fun:main
+}
+
+{
+Early permanent cache aligned erl_process:aux_work_tmo
+Memcheck:Leak
+fun:malloc
+fun:aux_work_timeout_early_init
+fun:erts_early_init_scheduling
+fun:early_init
+fun:erl_start
+fun:main
+}
+
+{
+Early permanent cache aligned ts_event_pool
+Memcheck:Leak
+fun:malloc
+fun:erts_sys_alloc
+fun:erts_alloc_fnf
+fun:ethr_std_alloc
+fun:ts_event_pool
+fun:init_ts_event_alloc
+fun:ethr_late_init_common__
+fun:ethr_late_init
+fun:erts_thr_late_init
+fun:early_init
+fun:erl_start
+fun:main
+}
+