aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/Makefile.in17
-rw-r--r--erts/emulator/beam/atom.names9
-rw-r--r--erts/emulator/beam/beam_emu.c155
-rw-r--r--erts/emulator/beam/beam_load.c88
-rw-r--r--erts/emulator/beam/bif.c48
-rw-r--r--erts/emulator/beam/bif.tab36
-rw-r--r--erts/emulator/beam/binary.c57
-rw-r--r--erts/emulator/beam/break.c2
-rw-r--r--erts/emulator/beam/copy.c130
-rw-r--r--erts/emulator/beam/erl_alloc.types1
-rw-r--r--erts/emulator/beam/erl_bif_binary.c2930
-rw-r--r--erts/emulator/beam/erl_bif_guard.c37
-rw-r--r--erts/emulator/beam/erl_bif_info.c17
-rw-r--r--erts/emulator/beam/erl_bif_port.c4
-rw-r--r--erts/emulator/beam/erl_bif_timer.c2
-rw-r--r--erts/emulator/beam/erl_binary.h25
-rw-r--r--erts/emulator/beam/erl_db_util.c17
-rw-r--r--erts/emulator/beam/erl_debug.c6
-rw-r--r--erts/emulator/beam/erl_gc.c101
-rw-r--r--erts/emulator/beam/erl_gc.h39
-rw-r--r--erts/emulator/beam/erl_init.c54
-rw-r--r--erts/emulator/beam/erl_message.c133
-rw-r--r--erts/emulator/beam/erl_message.h27
-rw-r--r--erts/emulator/beam/erl_nif.c384
-rw-r--r--erts/emulator/beam/erl_nif.h38
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h68
-rw-r--r--erts/emulator/beam/erl_port_task.c8
-rw-r--r--erts/emulator/beam/erl_process.c77
-rw-r--r--erts/emulator/beam/erl_process.h2
-rw-r--r--erts/emulator/beam/erl_threads.h14
-rw-r--r--erts/emulator/beam/erl_trace.c4
-rw-r--r--erts/emulator/beam/erl_vm.h4
-rw-r--r--erts/emulator/beam/global.h13
-rw-r--r--erts/emulator/beam/io.c26
-rw-r--r--erts/emulator/beam/ops.tab59
-rw-r--r--erts/emulator/beam/register.c37
-rw-r--r--erts/emulator/beam/sys.h18
-rw-r--r--erts/emulator/beam/utils.c5
-rw-r--r--erts/emulator/drivers/common/efile_drv.c57
-rw-r--r--erts/emulator/drivers/common/erl_efile.h13
-rw-r--r--erts/emulator/drivers/common/inet_drv.c77
-rw-r--r--erts/emulator/drivers/common/ram_file_drv.c17
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c22
-rw-r--r--erts/emulator/drivers/win32/win_efile.c31
-rw-r--r--erts/emulator/hipe/hipe_gc.c18
-rw-r--r--erts/emulator/sys/common/erl_poll.c59
-rw-r--r--erts/emulator/sys/unix/erl9_start.c130
-rw-r--r--erts/emulator/sys/win32/erl_poll.c65
-rw-r--r--erts/emulator/sys/win32/sys.c124
-rw-r--r--erts/emulator/test/Makefile4
-rw-r--r--erts/emulator/test/bif_SUITE.erl22
-rw-r--r--erts/emulator/test/binary_SUITE.erl10
-rw-r--r--erts/emulator/test/busy_port_SUITE.erl15
-rw-r--r--erts/emulator/test/distribution_SUITE.erl11
-rw-r--r--erts/emulator/test/fun_r12_SUITE.erl1
-rw-r--r--erts/emulator/test/guard_SUITE.erl179
-rw-r--r--erts/emulator/test/nif_SUITE.erl254
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c738
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.c80
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.h12
-rw-r--r--erts/emulator/test/port_SUITE.erl13
-rw-r--r--erts/emulator/test/receive_SUITE.erl113
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl11
63 files changed, 5830 insertions, 938 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 9f10a0ffaa..eca6121a1e 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -341,7 +341,6 @@ ERLANG_OSTYPE = @ERLANG_OSTYPE@
ENABLE_ALLOC_TYPE_VARS += @ERLANG_OSTYPE@
-EMULATOR_EXECUTABLE_SAE = beam_evm$(TF_MARKER)
EMULATOR_EXECUTABLE_ELIB = beam.elib$(TF_MARKER)
ifeq ($(TARGET), win32)
EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll
@@ -406,7 +405,7 @@ endif
@set -e ; cd zlib && $(MAKE) clean
@set -e ; cd pcre && $(MAKE) clean
-.PHONY: all sae zlib pcre clean
+.PHONY: all zlib pcre clean
docs:
@@ -640,10 +639,6 @@ $(BINDIR)/$(CS_EXECUTABLE): $(CS_SRC)
$(OBJDIR)/%.elib.o: beam/%.c
$(CC) $(ELIB_FLAGS) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
-# Disable vfork() for sae (then we don't need the child_setup program)
-$(OBJDIR)/sys_sae.o: sys/$(ERLANG_OSTYPE)/sys.c
- $(CC) -DDISABLE_VFORK=1 $(CFLAGS) $(INCLUDES) -c $< -o $@
-
$(OBJDIR)/%.kp.o: sys/common/%.c
$(CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
@@ -689,8 +684,6 @@ endif
INIT_OBJS = $(OBJDIR)/erl_main.o $(PRELOAD)
-INIT_OBJS_SAE = $(OBJDIR)/erl9_start.o
-
EMU_OBJS = \
$(OBJDIR)/beam_emu.o $(OBJDIR)/beam_opcodes.o \
$(OBJDIR)/beam_load.o $(OBJDIR)/beam_bif_load.o \
@@ -735,7 +728,8 @@ RUN_OBJS = \
$(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \
$(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \
$(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \
- $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o
+ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \
+ $(OBJDIR)/erl_bif_binary.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
@@ -825,7 +819,6 @@ endif
BASE_OBJS = $(RUN_OBJS) $(EMU_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS)
OBJS = $(BASE_OBJS) $(DRV_OBJS)
-OBJS_SAE = $(subst sys.o,sys_sae.o,$(OBJS))
ELIB_C_FILES = beam/elib_malloc.c \
beam/elib_memmove.c \
@@ -932,10 +925,6 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE_ELIB): $(INIT_OBJS) $(OBJS_ELIB) $(DEPLIBS)
$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE_ELIB) \
$(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS_ELIB) $(LIBS)
-$(BINDIR)/$(EMULATOR_EXECUTABLE_SAE): $(INIT_OBJS_SAE) $(OBJS_SAE) $(DEPLIBS)
- $(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE_SAE) \
- $(LDFLAGS) $(DEXPORT) $(INIT_OBJS_SAE) $(OBJS_SAE) $(LIBS)
-
endif
#
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 9ce21089ba..1138c0c871 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -65,6 +65,7 @@ atom EXIT='EXIT'
atom aborted
atom abs_path
atom absoluteURI
+atom ac
atom active
atom all
atom all_but_first
@@ -100,8 +101,15 @@ atom band
atom big
atom bif_return_trap
atom binary
+atom binary_bin_to_list_trap
+atom binary_copy_trap
+atom binary_longest_prefix_trap
+atom binary_longest_suffix_trap
+atom binary_match_trap
+atom binary_matches_trap
atom block
atom blocked
+atom bm
atom bnot
atom bor
atom bxor
@@ -454,6 +462,7 @@ atom scheduler
atom scheduler_id
atom schedulers_online
atom scheme
+atom scope
atom sensitive
atom sequential_tracer
atom sequential_trace_token
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 5b2f032afc..d42e74ccc9 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1539,6 +1539,10 @@ void process_main(void)
/*
* Skeleton for receive statement:
*
+ * recv_mark L1 Optional
+ * call make_ref/monitor Optional
+ * ...
+ * recv_set L1 Optional
* L1: <-------------------+
* <-----------+ |
* | |
@@ -1557,6 +1561,34 @@ void process_main(void)
*
*/
+ OpCase(recv_mark_f): {
+ /*
+ * Save the current position in message buffer and the
+ * the label for the loop_rec/2 instruction for the
+ * the receive statement.
+ */
+ c_p->msg.mark = (BeamInstr *) Arg(0);
+ c_p->msg.saved_last = c_p->msg.last;
+ Next(1);
+ }
+
+ OpCase(i_recv_set): {
+ /*
+ * If the mark is valid (points to the loop_rec/2
+ * instruction that follows), we know that the saved
+ * position points to the first message that could
+ * possibly be matched out.
+ *
+ * If the mark is invalid, we do nothing, meaning that
+ * we will look through all messages in the message queue.
+ */
+ if (c_p->msg.mark == (BeamInstr *) (I+1)) {
+ c_p->msg.save = c_p->msg.saved_last;
+ }
+ I++;
+ /* Fall through to the loop_rec/2 instruction */
+ }
+
/*
* Pick up the next message and place it in x(0).
* If no message, jump to a wait or wait_timeout instruction.
@@ -1994,6 +2026,81 @@ void process_main(void)
goto post_error_handling;
}
+ OpCase(i_gc_bif2_jIId): /* Note, one less parameter than the i_gc_bif1
+ and i_gc_bif3 */
+ {
+ typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
+ GcBifFunction bf;
+ Eterm result;
+ Uint live = (Uint) Arg(2);
+
+ reg[0] = r(0);
+ reg[live++] = tmp_arg1;
+ reg[live] = tmp_arg2;
+ bf = (GcBifFunction) Arg(1);
+ c_p->fcalls = FCALLS;
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ result = (*bf)(c_p, reg, live);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ r(0) = reg[0];
+ ERTS_HOLE_CHECK(c_p);
+ FCALLS = c_p->fcalls;
+ if (is_value(result)) {
+ StoreBifResult(3, result);
+ }
+ if (Arg(0) != 0) {
+ SET_I((BeamInstr *) Arg(0));
+ Goto(*I);
+ }
+ reg[0] = tmp_arg1;
+ reg[1] = tmp_arg2;
+ I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
+ goto post_error_handling;
+ }
+
+ OpCase(i_gc_bif3_jIsId):
+ {
+ typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
+ GcBifFunction bf;
+ Eterm arg;
+ Eterm result;
+ Uint live = (Uint) Arg(3);
+
+ GetArg1(2, arg);
+ reg[0] = r(0);
+ reg[live++] = arg;
+ reg[live++] = tmp_arg1;
+ reg[live] = tmp_arg2;
+ bf = (GcBifFunction) Arg(1);
+ c_p->fcalls = FCALLS;
+ SWAPOUT;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ result = (*bf)(c_p, reg, live);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ SWAPIN;
+ r(0) = reg[0];
+ ERTS_HOLE_CHECK(c_p);
+ FCALLS = c_p->fcalls;
+ if (is_value(result)) {
+ StoreBifResult(4, result);
+ }
+ if (Arg(0) != 0) {
+ SET_I((BeamInstr *) Arg(0));
+ Goto(*I);
+ }
+ reg[0] = arg;
+ reg[1] = tmp_arg1;
+ reg[2] = tmp_arg2;
+ I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
+ goto post_error_handling;
+ }
+
/*
* Guards bifs and, or, xor in guards.
*/
@@ -3110,12 +3217,6 @@ apply_bif_or_nif_epilogue:
StoreBifResult(1, result);
}
- OpCase(i_put_tuple_only_Ad): {
- tmp_arg1 = make_tuple(HTOP);
- *HTOP++ = Arg(0);
- StoreBifResult(1, tmp_arg1);
- }
-
OpCase(case_end_s):
GetArg1(0, tmp_arg1);
c_p->fvalue = tmp_arg1;
@@ -3426,42 +3527,6 @@ apply_bif_or_nif_epilogue:
}
}
- OpCase(i_bs_bits_to_bytes_rjd): {
- tmp_arg1 = r(0);
- goto do_bits_to_bytes;
- }
-
- OpCase(i_bs_bits_to_bytes_yjd): {
- tmp_arg1 = yb(Arg(0));
- I++;
- goto do_bits_to_bytes;
-
- OpCase(i_bs_bits_to_bytes_xjd): {
- tmp_arg1 = xb(Arg(0));
- I++;
- }
-
- do_bits_to_bytes:
- {
- if (is_valid_bit_size(tmp_arg1)) {
- tmp_arg1 = make_small(unsigned_val(tmp_arg1) >> 3);
- } else {
- Uint bytes;
- if (!term_to_Uint(tmp_arg1, &bytes)) {
- goto badarg;
- }
- tmp_arg1 = bytes;
- if ((tmp_arg1 & 0x07) != 0) {
- goto badarg;
- }
- SWAPOUT;
- tmp_arg1 = erts_make_integer(tmp_arg1 >> 3, c_p);
- HTOP = HEAP_TOP(c_p);
- }
- StoreBifResult(1, tmp_arg1);
- }
- }
-
OpCase(i_bs_add_jId): {
Uint Unit = Arg(1);
if (is_both_small(tmp_arg1, tmp_arg2)) {
@@ -3499,7 +3564,7 @@ apply_bif_or_nif_epilogue:
/*
* Now we know that one of the arguments is
- * not at small. We must convert both arguments
+ * not a small. We must convert both arguments
* to Uints and check for errors at the same time.
*
* Error checking is tricky.
@@ -4954,6 +5019,10 @@ translate_gc_bif(void* gcf)
return round_1;
} else if (gcf == erts_gc_trunc_1) {
return round_1;
+ } else if (gcf == erts_gc_binary_part_2) {
+ return binary_part_2;
+ } else if (gcf == erts_gc_binary_part_3) {
+ return binary_part_3;
} else {
erl_exit(1, "bad gc bif");
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 5e4375fc96..30f276b95a 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -486,9 +486,6 @@ static GenOp* const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
GenOpArg Size, GenOpArg* Rest);
static GenOp* gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg Func,
GenOpArg arity, GenOpArg label);
-static GenOp*
-gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
- GenOpArg Src, GenOpArg Dst);
static int freeze_code(LoaderState* stp);
@@ -3358,9 +3355,15 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
op->next = NULL;
return op;
}
-
+/*
+ * Rewrite gc_bifs with one parameter (the common case). Utilized
+ * in ops.tab to rewrite instructions calling bif's in guards
+ * to use a garbage collecting implementation. The instructions
+ * are sometimes once again rewritten to handle literals (putting the
+ * parameter in the mostly unused r[0] before the instruction is executed).
+ */
static GenOp*
-gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
+gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
GenOpArg Src, GenOpArg Dst)
{
GenOp* op;
@@ -3372,6 +3375,8 @@ gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
op->a[0] = Fail;
op->a[1].type = TAG_u;
bf = stp->import[Bif.val].bf;
+ /* The translations here need to have a reverse counterpart in
+ beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == length_1) {
op->a[1].val = (BeamInstr) (void *) erts_gc_length_1;
} else if (bf == size_1) {
@@ -3398,6 +3403,77 @@ gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
return op;
}
+/*
+ * 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.
+ * 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.
+ */
+static GenOp*
+gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
+ GenOpArg S1, GenOpArg S2, GenOpArg Dst)
+{
+ GenOp* op;
+ BifFunction bf;
+
+ NEW_GENOP(stp, op);
+ op->op = genop_ii_gc_bif2_6;
+ op->arity = 6;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
+ 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->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
+ * 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
+ * always occur, as with the gc_bif2 counterpart.
+ */
+static GenOp*
+gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
+ GenOpArg S1, GenOpArg S2, GenOpArg S3, GenOpArg Dst)
+{
+ GenOp* op;
+ BifFunction bf;
+
+ NEW_GENOP(stp, op);
+ op->op = genop_ii_gc_bif3_7;
+ op->arity = 7;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
+ 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->a[2] = S1;
+ op->a[3] = S2;
+ op->a[4] = S3;
+ op->a[5] = Live;
+ op->a[6] = Dst;
+ op->next = NULL;
+ return op;
+}
+
/*
* Freeze the code in memory, move the string table into place,
@@ -3464,7 +3540,7 @@ freeze_code(LoaderState* stp)
literal_end = (Uint *) (code+stp->ci);
/*
* Place the literal heap directly after the code and fix up all
- * put_literal instructions that refer to it.
+ * instructions that refer to it.
*/
{
Uint* ptr;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 85bf584337..10cc2e9003 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -4143,54 +4143,6 @@ void erts_init_bif(void)
await_proc_exit_trap = erts_export_put(am_erlang,am_await_proc_exit,3);
}
-BIF_RETTYPE blocking_read_file_1(BIF_ALIST_1)
-{
- Eterm bin;
- Eterm* hp;
- byte *buff;
- int i, buff_size;
- FILE *file;
- struct stat file_info;
- char *filename = NULL;
- size_t size;
-
- i = list_length(BIF_ARG_1);
- if (i < 0) {
- BIF_ERROR(BIF_P, BADARG);
- }
- filename = erts_alloc(ERTS_ALC_T_TMP, i + 1);
- if (intlist_to_buf(BIF_ARG_1, filename, i) != i)
- erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
- filename[i] = '\0';
-
- hp = HAlloc(BIF_P, 3);
-
- file = fopen(filename, "r");
- if(file == NULL){
- erts_free(ERTS_ALC_T_TMP, (void *) filename);
- BIF_RET(TUPLE2(hp, am_error, am_nofile));
- }
-
- stat(filename, &file_info);
- erts_free(ERTS_ALC_T_TMP, (void *) filename);
-
- buff_size = file_info.st_size;
- buff = (byte *) erts_alloc_fnf(ERTS_ALC_T_TMP, buff_size);
- if (!buff) {
- fclose(file);
- BIF_RET(TUPLE2(hp, am_error, am_allocator));
- }
- size = fread(buff, 1, buff_size, file);
- fclose(file);
- if (size < 0)
- size = 0;
- else if (size > buff_size)
- size = (size_t) buff_size;
- bin = new_binary(BIF_P, buff, (int) size);
- erts_free(ERTS_ALC_T_TMP, (void *) buff);
-
- BIF_RET(TUPLE2(hp, am_ok, bin));
-}
#ifdef HARDDEBUG
/*
You'll need this line in bif.tab to be able to use this debug bif
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index b6fa06354a..38e2dd77d3 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -686,8 +686,6 @@ bif 'erl.system.code':make_stub_module/3 ebif_code_make_stub_module_3
bif code:is_module_native/1
bif 'erl.system.code':is_native/1 ebif_code_is_native_1 code_is_module_native_1
-bif erlang:blocking_read_file/1
-
#
# New Bifs in R9C.
#
@@ -760,6 +758,40 @@ bif erlang:finish_after_on_load/2
bif erlang:binary_to_term/2
#
+# The binary match bifs (New in R14A - EEP9)
+#
+
+#
+# The searching/splitting/substituting thingies
+#
+ubif erlang:binary_part/2
+ubif erlang:binary_part/3
+
+bif binary:compile_pattern/1
+bif binary:match/2
+bif binary:match/3
+bif binary:matches/2
+bif binary:matches/3
+bif binary:longest_common_prefix/1
+bif binary:longest_common_suffix/1
+bif binary:first/1
+bif binary:last/1
+bif binary:at/2
+bif binary:part/2 binary_binary_part_2
+bif binary:part/3 binary_binary_part_3
+bif binary:bin_to_list/1
+bif binary:bin_to_list/2
+bif binary:bin_to_list/3
+bif binary:list_to_bin/1
+bif binary:copy/1
+bif binary:copy/2
+bif binary:referenced_byte_size/1
+bif binary:encode_unsigned/1
+bif binary:encode_unsigned/2
+bif binary:decode_unsigned/1
+bif binary:decode_unsigned/2
+
+#
# Obsolete
#
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index 59c20398d5..c68392fad4 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -180,7 +180,7 @@ erts_realloc_binary(Eterm bin, size_t size)
}
byte*
-erts_get_aligned_binary_bytes_extra(Eterm bin, byte** base_ptr, unsigned extra)
+erts_get_aligned_binary_bytes_extra(Eterm bin, byte** base_ptr, ErtsAlcType_t allocator, unsigned extra)
{
byte* bytes;
Eterm* real_bin;
@@ -208,7 +208,7 @@ erts_get_aligned_binary_bytes_extra(Eterm bin, byte** base_ptr, unsigned extra)
bytes = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + offs;
}
if (bit_offs) {
- byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, byte_size + extra);
+ byte* buf = (byte *) erts_alloc(allocator, byte_size + extra);
*base_ptr = buf;
buf += extra;
erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, byte_size*8);
@@ -346,29 +346,40 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
/* Turn a possibly deep list of ints (and binaries) into */
/* One large binary object */
-BIF_RETTYPE list_to_binary_1(BIF_ALIST_1)
+/*
+ * This bif also exists in the binary module, under the name
+ * binary:list_to_bin/1, why it's divided into interface and
+ * implementation. Also the backend for iolist_to_binary_1.
+ */
+
+BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
{
Eterm bin;
int i;
int offset;
byte* bytes;
- if (is_nil(BIF_ARG_1)) {
- BIF_RET(new_binary(BIF_P,(byte*)"",0));
+ if (is_nil(arg)) {
+ BIF_RET(new_binary(p,(byte*)"",0));
}
- if (is_not_list(BIF_ARG_1)) {
+ if (is_not_list(arg)) {
goto error;
}
- if ((i = io_list_len(BIF_ARG_1)) < 0) {
+ if ((i = io_list_len(arg)) < 0) {
goto error;
}
- bin = new_binary(BIF_P, (byte *)NULL, i);
+ bin = new_binary(p, (byte *)NULL, i);
bytes = binary_bytes(bin);
- offset = io_list_to_buf(BIF_ARG_1, (char*) bytes, i);
+ offset = io_list_to_buf(arg, (char*) bytes, i);
ASSERT(offset == 0);
BIF_RET(bin);
- error:
- BIF_ERROR(BIF_P, BADARG);
+ error:
+ BIF_ERROR(p, BADARG);
+}
+
+BIF_RETTYPE list_to_binary_1(BIF_ALIST_1)
+{
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
}
/* Turn a possibly deep list of ints (and binaries) into */
@@ -376,31 +387,10 @@ BIF_RETTYPE list_to_binary_1(BIF_ALIST_1)
BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1)
{
- Eterm bin;
- int i;
- int offset;
- byte* bytes;
-
if (is_binary(BIF_ARG_1)) {
BIF_RET(BIF_ARG_1);
}
- if (is_nil(BIF_ARG_1)) {
- BIF_RET(new_binary(BIF_P,(byte*)"",0));
- }
- if (is_not_list(BIF_ARG_1)) {
- goto error;
- }
- if ((i = io_list_len(BIF_ARG_1)) < 0) {
- goto error;
- }
- bin = new_binary(BIF_P, (byte *)NULL, i);
- bytes = binary_bytes(bin);
- offset = io_list_to_buf(BIF_ARG_1, (char*) bytes, i);
- ASSERT(offset == 0);
- BIF_RET(bin);
-
- error:
- BIF_ERROR(BIF_P, BADARG);
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1)
@@ -675,3 +665,4 @@ bitstr_list_len(Eterm obj)
DESTROY_ESTACK(s);
return (Sint) -1;
}
+
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 5cb1481a3a..857cb177c8 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -258,12 +258,10 @@ print_process_info(int to, void *to_arg, Process *p)
}
{
- long s = 0;
int frags = 0;
ErlHeapFragment *m = p->mbuf;
while (m != NULL) {
frags++;
- s += m->size;
m = m->next;
}
erts_print(to, to_arg, "Number of heap fragments: %d\n", frags);
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 0a5050b1fe..521a1b1788 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1996-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
* 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%
*/
@@ -37,6 +37,8 @@ MA_STACK_DECLARE(dst);
MA_STACK_DECLARE(offset);
#endif
+static void move_one_frag(Eterm** hpp, Eterm* src, Uint src_sz, ErlOffHeap*);
+
void
init_copy(void)
{
@@ -86,7 +88,7 @@ size_object(Eterm obj)
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
- }
+ }
obj = *ptr;
break;
case TAG_PRIMARY_BOXED:
@@ -99,7 +101,7 @@ size_object(Eterm obj)
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
- goto size_common;
+ goto pop_next;
}
while (arity-- > 1) {
obj = *++ptr;
@@ -115,7 +117,6 @@ size_object(Eterm obj)
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
-
sum += 1 /* header */ + sz + eterms;
bptr += 1 /* header */ + sz;
while (eterms-- > 1) {
@@ -151,7 +152,7 @@ size_object(Eterm obj)
} else {
sum += heap_bin_size(binary_size(obj)+extra_bytes);
}
- goto size_common;
+ goto pop_next;
}
break;
case BIN_MATCHSTATE_SUBTAG:
@@ -159,18 +160,12 @@ size_object(Eterm obj)
"size_object: matchstate term not allowed");
default:
sum += thing_arityval(hdr) + 1;
- /* Fall through */
- size_common:
- if (ESTACK_ISEMPTY(s)) {
- DESTROY_ESTACK(s);
- return sum;
- }
- obj = ESTACK_POP(s);
- break;
+ goto pop_next;
}
}
break;
case TAG_PRIMARY_IMMED1:
+ pop_next:
if (ESTACK_ISEMPTY(s)) {
DESTROY_ESTACK(s);
return sum;
@@ -979,3 +974,104 @@ copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
*hpp = hp;
return make_tuple(ptr + offs);
}
+
+/* Move all terms in heap fragments into heap. The terms must be guaranteed to
+ * be contained within the fragments. The source terms are destructed with
+ * move markers.
+ * Typically used to copy a multi-fragmented message (from NIF).
+ */
+void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
+ Eterm* refs, unsigned nrefs)
+{
+ ErlHeapFragment* bp;
+ Eterm* hp_start = *hpp;
+ Eterm* hp_end;
+ Eterm* hp;
+ unsigned i;
+
+ for (bp=first; bp!=NULL; bp=bp->next) {
+ move_one_frag(hpp, bp->mem, bp->used_size, off_heap);
+ off_heap->overhead += bp->off_heap.overhead;
+ }
+ hp_end = *hpp;
+ for (hp=hp_start; hp<hp_end; ++hp) {
+ Eterm* ptr;
+ Eterm val;
+ Eterm gval = *hp;
+ switch (primary_tag(gval)) {
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(gval);
+ val = *ptr;
+ if (IS_MOVED_BOXED(val)) {
+ ASSERT(is_boxed(val));
+ *hp = val;
+ }
+ break;
+ case TAG_PRIMARY_LIST:
+ ptr = list_val(gval);
+ val = *ptr;
+ if (IS_MOVED_CONS(val)) {
+ *hp = ptr[1];
+ }
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (header_is_thing(gval)) {
+ hp += thing_arityval(gval);
+ }
+ break;
+ }
+ }
+ for (i=0; i<nrefs; ++i) {
+ refs[i] = follow_moved(refs[i]);
+ }
+}
+
+static void
+move_one_frag(Eterm** hpp, Eterm* src, Uint src_sz, ErlOffHeap* off_heap)
+{
+ union {
+ Uint *up;
+ ProcBin *pbp;
+ ErlFunThing *efp;
+ ExternalThing *etp;
+ } ohe;
+ Eterm* ptr = src;
+ Eterm* end = ptr + src_sz;
+ Eterm dummy_ref;
+ Eterm* hp = *hpp;
+
+ while (ptr != end) {
+ Eterm val;
+ ASSERT(ptr < end);
+ val = *ptr;
+ ASSERT(val != ERTS_HOLE_MARKER);
+ if (is_header(val)) {
+ ASSERT(ptr + header_arity(val) < end);
+ ohe.up = hp;
+ MOVE_BOXED(ptr, val, hp, &dummy_ref);
+ switch (val & _HEADER_SUBTAG_MASK) {
+ case REFC_BINARY_SUBTAG:
+ ohe.pbp->next = off_heap->mso;
+ off_heap->mso = ohe.pbp;
+ break;
+ case FUN_SUBTAG:
+ ohe.efp->next = off_heap->funs;
+ off_heap->funs = ohe.efp;
+ break;
+ case EXTERNAL_PID_SUBTAG:
+ case EXTERNAL_PORT_SUBTAG:
+ case EXTERNAL_REF_SUBTAG:
+ ohe.etp->next = off_heap->externals;
+ off_heap->externals = ohe.etp;
+ break;
+ }
+ }
+ else { /* must be a cons cell */
+ ASSERT(ptr+1 < end);
+ MOVE_CONS(ptr, val, hp, &dummy_ref);
+ ptr += 2;
+ }
+ }
+ *hpp = hp;
+}
+
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 5d2872a4e3..6f88bbe5b8 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -232,6 +232,7 @@ type RE_SUBJECT SHORT_LIVED SYSTEM re_subject
type RE_HEAP STANDARD SYSTEM re_heap
type RE_STACK SHORT_LIVED SYSTEM re_stack
type UNICODE_BUFFER SHORT_LIVED SYSTEM unicode_buffer
+type BINARY_BUFFER SHORT_LIVED SYSTEM binary_buffer
type PRE_ALLOC_DATA LONG_LIVED SYSTEM pre_alloc_data
type DRV_THR_OPTS DRIVER SYSTEM driver_thread_opts
type DRV_TID DRIVER SYSTEM driver_tid
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
new file mode 100644
index 0000000000..82f1e06e8e
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -0,0 +1,2930 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 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
+ * 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%
+ */
+
+/*
+ * NOTE: This file contains the BIF's for the *module* binary in stdlib.
+ * other BIF's concerning binaries are in binary.c.
+ */
+
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include "sys.h"
+#include "erl_vm.h"
+#include "global.h"
+#include "erl_process.h"
+#include "error.h"
+#include "bif.h"
+#include "big.h"
+#include "erl_binary.h"
+#include "erl_bits.h"
+
+
+/*
+ * The native implementation functions for the module binary.
+ * Searching is implemented using either Boyer-Moore or Aho-Corasick
+ * depending on number of searchstrings (BM if one, AC if more than one).
+ * Native implementation is mostly for efficiency, nothing
+ * (except binary:referenced_byte_size) really *needs* to be implemented
+ * in native code.
+ */
+
+/* #define HARDDEBUG */
+
+/* Init and local variables */
+
+static Export binary_match_trap_export;
+static BIF_RETTYPE binary_match_trap(BIF_ALIST_3);
+static Export binary_matches_trap_export;
+static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3);
+static Export binary_longest_prefix_trap_export;
+static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3);
+static Export binary_longest_suffix_trap_export;
+static BIF_RETTYPE binary_longest_suffix_trap(BIF_ALIST_3);
+static Export binary_bin_to_list_trap_export;
+static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3);
+static Export binary_copy_trap_export;
+static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
+static Uint max_loop_limit;
+
+
+void erts_init_bif_binary(void)
+{
+ sys_memset((void *) &binary_match_trap_export, 0, sizeof(Export));
+ binary_match_trap_export.address = &binary_match_trap_export.code[3];
+ binary_match_trap_export.code[0] = am_erlang;
+ binary_match_trap_export.code[1] = am_binary_match_trap;
+ binary_match_trap_export.code[2] = 3;
+ binary_match_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ binary_match_trap_export.code[4] = (BeamInstr) &binary_match_trap;
+
+ sys_memset((void *) &binary_matches_trap_export, 0, sizeof(Export));
+ binary_matches_trap_export.address = &binary_matches_trap_export.code[3];
+ binary_matches_trap_export.code[0] = am_erlang;
+ binary_matches_trap_export.code[1] = am_binary_matches_trap;
+ binary_matches_trap_export.code[2] = 3;
+ binary_matches_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ binary_matches_trap_export.code[4] = (BeamInstr) &binary_matches_trap;
+
+ sys_memset((void *) &binary_longest_prefix_trap_export, 0, sizeof(Export));
+ binary_longest_prefix_trap_export.address = &binary_longest_prefix_trap_export.code[3];
+ binary_longest_prefix_trap_export.code[0] = am_erlang;
+ binary_longest_prefix_trap_export.code[1] = am_binary_longest_prefix_trap;
+ binary_longest_prefix_trap_export.code[2] = 3;
+ binary_longest_prefix_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ binary_longest_prefix_trap_export.code[4] = (BeamInstr) &binary_longest_prefix_trap;
+
+ sys_memset((void *) &binary_longest_suffix_trap_export, 0, sizeof(Export));
+ binary_longest_suffix_trap_export.address = &binary_longest_suffix_trap_export.code[3];
+ binary_longest_suffix_trap_export.code[0] = am_erlang;
+ binary_longest_suffix_trap_export.code[1] = am_binary_longest_suffix_trap;
+ binary_longest_suffix_trap_export.code[2] = 3;
+ binary_longest_suffix_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ binary_longest_suffix_trap_export.code[4] = (BeamInstr) &binary_longest_suffix_trap;
+
+ sys_memset((void *) &binary_bin_to_list_trap_export, 0, sizeof(Export));
+ binary_bin_to_list_trap_export.address = &binary_bin_to_list_trap_export.code[3];
+ binary_bin_to_list_trap_export.code[0] = am_erlang;
+ binary_bin_to_list_trap_export.code[1] = am_binary_bin_to_list_trap;
+ binary_bin_to_list_trap_export.code[2] = 3;
+ binary_bin_to_list_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ binary_bin_to_list_trap_export.code[4] = (BeamInstr) &binary_bin_to_list_trap;
+ sys_memset((void *) &binary_copy_trap_export, 0, sizeof(Export));
+ binary_copy_trap_export.address = &binary_copy_trap_export.code[3];
+ binary_copy_trap_export.code[0] = am_erlang;
+ binary_copy_trap_export.code[1] = am_binary_copy_trap;
+ binary_copy_trap_export.code[2] = 2;
+ binary_copy_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ binary_copy_trap_export.code[4] = (BeamInstr) &binary_copy_trap;
+
+ max_loop_limit = 0;
+ return;
+}
+
+/*
+ * Setting the loop_limit for searches for debugging
+ */
+Sint erts_binary_set_loop_limit(Sint limit)
+{
+ Sint save = (Sint) max_loop_limit;
+ if (limit <= 0) {
+ max_loop_limit = 0;
+ } else {
+ max_loop_limit = (Uint) limit;
+ }
+
+ return save;
+}
+
+static Uint get_reds(Process *p, int loop_factor)
+{
+ Uint reds = ERTS_BIF_REDS_LEFT(p) * loop_factor;
+ Uint tmp = max_loop_limit;
+ if (tmp != 0 && tmp < reds) {
+ return tmp;
+ }
+ if (!reds) {
+ reds = 1;
+ }
+ return reds;
+}
+
+/*
+ * A micro allocator used when building search structures, just a convenience
+ * for building structures inside a pre-allocated magic binary using
+ * conventional malloc-like interface.
+ */
+
+#define MYALIGN(Size) (SIZEOF_VOID_P * (((Size) / SIZEOF_VOID_P) + \
+ !!(((Size) % SIZEOF_VOID_P))))
+
+#ifdef DEBUG
+#define CHECK_ALLOCATOR(My) ASSERT((My).current <= ((My).mem + (My).size))
+#else
+#define CHECK_ALLOCATOR(My) /* nothing */
+#endif
+
+typedef struct _my_allocator {
+ Uint size;
+ byte *current;
+ byte *mem;
+} MyAllocator;
+
+static void init_my_allocator(MyAllocator *my, Uint siz, byte *array)
+{
+ ASSERT((siz % SIZEOF_VOID_P) == 0);
+ my->size = siz;
+ my->mem = array;
+ my->current = my->mem;
+}
+
+static void *my_alloc(MyAllocator *my, Uint size)
+{
+ void *ptr = my->current;
+ my->current += MYALIGN(size);
+ return ptr;
+}
+
+/*
+ * The search functionality.
+ *
+ * The search is byte oriented, which works nicely for UTF-8 as well as
+ * latin1 data
+ */
+
+#define ALPHABET_SIZE 256
+
+typedef struct _ac_node {
+#ifdef HARDDEBUG
+ Uint32 id; /* To identify h pointer targets when
+ dumping */
+#endif
+ Uint32 d; /* Depth in trie, also represents the
+ length (-1) of the matched string if
+ in final set */
+ Sint32 final; /* Members in final set represent
+ * matches.
+ * The set representation is scattered
+ * among the nodes in this way:
+ * >0 -> this represents a member of
+ * the final set, <0 -> member of
+ * final set somewhere in the failure
+ * chain,
+ * 0 -> not member of the final set */
+ struct _ac_node *h; /* h(Hode) is the failure function */
+ struct _ac_node *g[ALPHABET_SIZE]; /* g(Node,Character) is the
+ transition function */
+} ACNode;
+
+typedef struct _ac_trie {
+#ifdef HARDDEBUG
+ Uint32 idc;
+#endif
+ Uint32 counter; /* Number of added patterns */
+ ACNode *root; /* pointer to the root state */
+} ACTrie;
+
+typedef struct _bm_data {
+ byte *x;
+ Sint len;
+ Sint *goodshift;
+ Sint badshift[ALPHABET_SIZE];
+} BMData;
+
+#ifdef HARDDEBUG
+static void dump_bm_data(BMData *bm);
+static void dump_ac_trie(ACTrie *act);
+static void dump_ac_node(ACNode *node, int indent, int ch);
+#endif
+
+/*
+ * The needed size of binary data for a search structure - given the
+ * accumulated string lengths.
+ */
+#define BM_SIZE(StrLen) /* StrLen: length of searchstring */ \
+((MYALIGN(sizeof(Sint) * (StrLen))) + /* goodshift array */ \
+ MYALIGN(StrLen) + /* searchstring saved */ \
+ (MYALIGN(sizeof(BMData)))) /* Structure */
+
+#define AC_SIZE(StrLens) /* StrLens: sum of all searchstring lengths */ \
+((MYALIGN(sizeof(ACNode)) * \
+((StrLens)+1)) + /* The actual nodes (including rootnode) */ \
+ MYALIGN(sizeof(ACTrie))) /* Structure */
+
+
+#ifndef MAX
+#define MAX(A,B) (((A) > (B)) ? (A) : (B))
+#endif
+
+#ifndef MIN
+#define MIN(A,B) (((A) > (B)) ? (B) : (A))
+#endif
+/*
+ * Callback for the magic binary
+ */
+static void cleanup_my_data_ac(Binary *bp)
+{
+ return;
+}
+static void cleanup_my_data_bm(Binary *bp)
+{
+ return;
+}
+
+/*
+ * Initiate a (allocated) micro allocator and fill in the base
+ * for an Aho-Corasick search trie, given the accumulated length of the search
+ * strings.
+ */
+static ACTrie *create_acdata(MyAllocator *my, Uint len,
+ ACNode ***qbuff /* out */,
+ Binary **the_bin /* out */)
+{
+ Uint datasize = AC_SIZE(len);
+ ACTrie *act;
+ ACNode *acn;
+ Binary *mb = erts_create_magic_binary(datasize,cleanup_my_data_ac);
+ byte *data = ERTS_MAGIC_BIN_DATA(mb);
+
+ init_my_allocator(my, datasize, data);
+ act = my_alloc(my, sizeof(ACTrie)); /* Important that this is the first
+ allocation */
+ act->counter = 0;
+ act->root = acn = my_alloc(my, sizeof(ACNode));
+ acn->d = 0;
+ acn->final = 0;
+ acn->h = NULL;
+ memset(acn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE);
+#ifdef HARDDEBUG
+ act->idc = 0;
+ acn->id = 0;
+#endif
+ *qbuff = erts_alloc(ERTS_ALC_T_TMP, sizeof(ACNode *) * len);
+ *the_bin = mb;
+ return act;
+}
+
+/*
+ * The same initialization of allocator and basic data for Boyer-Moore.
+ */
+static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len,
+ Binary **the_bin /* out */)
+{
+ Uint datasize = BM_SIZE(len);
+ BMData *bmd;
+ Binary *mb = erts_create_magic_binary(datasize,cleanup_my_data_bm);
+ byte *data = ERTS_MAGIC_BIN_DATA(mb);
+ init_my_allocator(my, datasize, data);
+ bmd = my_alloc(my, sizeof(BMData));
+ bmd->x = my_alloc(my,len);
+ memcpy(bmd->x,x,len);
+ bmd->len = len;
+ bmd->goodshift = my_alloc(my,sizeof(Uint) * len);
+ *the_bin = mb;
+ return bmd;
+}
+
+/*
+ * Compilation of search structures
+ */
+
+/*
+ * Aho Corasick - Build a Trie and fill in the failure functions
+ * when all strings are added.
+ * The algorithm is nicely described by Dieter B�hler of University of
+ * T�bingen:
+ * http://www-sr.informatik.uni-tuebingen.de/~buehler/AC/AC.html
+ */
+
+/*
+ * Helper called once for each search pattern
+ */
+static void ac_add_one_pattern(MyAllocator *my, ACTrie *act, byte *x, Uint len)
+{
+ ACNode *acn = act->root;
+ Uint32 n = ++act->counter; /* Always increase counter, even if it's a
+ duplicate as this may identify the pattern
+ in the final set (not in current interface
+ though) */
+ Uint i = 0;
+
+ while(i < len) {
+ if (acn->g[x[i]] != NULL) {
+ /* node exists, continue */
+ acn = acn->g[x[i]];
+ ++i;
+ } else {
+ /* allocate a new node */
+ ACNode *nn = my_alloc(my,sizeof(ACNode));
+#ifdef HARDDEBUG
+ nn->id = ++(act->idc);
+#endif
+ nn->d = i+1;
+ nn->h = act->root;
+ nn->final = 0;
+ memset(nn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE);
+ acn->g[x[i]] = nn;
+ ++i;
+ acn = nn;
+ }
+ }
+ if (acn->final == 0) { /* New pattern, add to final set */
+ acn->final = n;
+ }
+}
+
+/*
+ * Called when all search patterns are added.
+ */
+static void ac_compute_failure_functions(ACTrie *act, ACNode **qbuff)
+{
+ ACNode *root = act->root;
+ ACNode *parent;
+ int i;
+ int qh = 0,qt = 0;
+ ACNode *child, *r;
+
+ /* Set all children of the root to have the root as failure function */
+ for (i = 0; i < ALPHABET_SIZE; ++i) {
+ if (root->g[i] != NULL) {
+ root->g[i]->h = root;
+ /* Add to que for later traversal */
+ qbuff[qt++] = root->g[i];
+ }
+ }
+
+ /* So, now we've handled children of the root state, traverse the
+ rest of the trie BF... */
+ while (qh < qt) {
+ parent = qbuff[qh++];
+ for (i = 0; i < ALPHABET_SIZE; ++ i) {
+ if ((child = parent->g[i]) != NULL) {
+ /* Visit this node to */
+ qbuff[qt++] = child;
+ /* Search for correct failure function, follow the parent's
+ failure function until you find a similar transition
+ funtion to this child's */
+ r = parent->h;
+ while (r != NULL && r->g[i] == NULL) {
+ r = r->h;
+ }
+ if (r == NULL) {
+ /* Replace NULL failures with the root as we go */
+ child->h = (root->g[i] == NULL) ? root : root->g[i];
+ } else {
+ child->h = r->g[i];
+ /*
+ * The "final" set is scattered among the nodes. When
+ * the failure function points to a member of the final
+ * set, we have a match, but we might not see it in the
+ * current node if we dont mark it as a special type of
+ * final, i.e. foolow the failure function and you will
+ * find a real member of final set. This is marked with
+ * a negative string id and only done if this node does
+ * not represent a member in the final set.
+ */
+ if (!(child->final) && (child->h->final)) {
+ child->final = -1;
+ }
+ }
+ }
+ }
+ }
+ /* Finally the failure function of the root should point to itself */
+ root->h = root;
+}
+
+
+/*
+ * The actual searching for needles in the haystack...
+ * Find first match using Aho-Coracick Trie
+ * return pattern number and fill in mpos + mlen if found, otherwise return 0
+ * Return the matching pattern that *starts* first, and ends
+ * last (difference when overlapping), hence the candidate thing.
+ * Basic AC finds the first end before the first start...
+ *
+ */
+typedef struct {
+ ACNode *q;
+ Uint pos;
+ Uint len;
+ ACNode *candidate;
+ Uint candidate_start;
+} ACFindFirstState;
+
+
+static void ac_init_find_first_match(ACFindFirstState *state, ACTrie *act, Sint startpos, Uint len)
+{
+ state->q = act->root;
+ state->pos = startpos;
+ state->len = len;
+ state->candidate = NULL;
+ state->candidate_start = 0;
+}
+#define AC_OK 0
+#define AC_NOT_FOUND -1
+#define AC_RESTART -2
+
+#define AC_LOOP_FACTOR 10
+
+static int ac_find_first_match(ACFindFirstState *state, byte *haystack,
+ Uint *mpos, Uint *mlen, Uint *reductions)
+{
+ ACNode *q = state->q;
+ Uint i = state->pos;
+ ACNode *candidate = state->candidate, *r;
+ Uint len = state->len;
+ Uint candidate_start = state->candidate_start;
+ Uint rstart;
+ register Uint reds = *reductions;
+
+ while (i < len) {
+ if (--reds == 0) {
+ state->q = q;
+ state->pos = i;
+ state->len = len;
+ state->candidate = candidate;
+ state->candidate_start = candidate_start;
+ return AC_RESTART;
+ }
+
+ while (q->g[haystack[i]] == NULL && q->h != q) {
+ q = q->h;
+ }
+ if (q->g[haystack[i]] != NULL) {
+ q = q->g[haystack[i]];
+ }
+#ifdef HARDDEBUG
+ erts_printf("ch = %c, Current: %u\n", (int) haystack[i], (unsigned) q->id);
+#endif
+ ++i;
+ if (candidate != NULL && (i - q->d) > candidate_start) {
+ break;
+ }
+ if (q->final) {
+ r = q;
+ while (r->final < 0)
+ r = r->h;
+ rstart = i - r->d;
+ if (candidate == NULL || rstart < candidate_start ||
+ (rstart == candidate_start && candidate->d < q->d)) {
+ candidate_start = rstart;
+ candidate = r;
+ }
+ }
+ }
+ *reductions = reds;
+ if (!candidate) {
+ return AC_NOT_FOUND;
+ }
+#ifdef HARDDEBUG
+ dump_ac_node(candidate,0,'?');
+#endif
+ *mpos = candidate_start;
+ *mlen = candidate->d;
+ return AC_OK;
+}
+
+typedef struct _findall_data {
+ Uint pos;
+ Uint len;
+#ifdef HARDDEBUG
+ Uint id;
+#endif
+ Eterm epos;
+ Eterm elen;
+} FindallData;
+
+typedef struct {
+ ACNode *q;
+ Uint pos;
+ Uint len;
+ Uint m;
+ Uint allocated;
+ FindallData *out;
+} ACFindAllState;
+
+static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos, Uint len)
+{
+ state->q = act->root;
+ state->pos = startpos;
+ state->len = len;
+ state->m = 0;
+ state->allocated = 0;
+ state->out = NULL;
+}
+
+static void ac_restore_find_all(ACFindAllState *state, char *buff)
+{
+ memcpy(state,buff,sizeof(ACFindAllState));
+ state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated));
+ memcpy(state->out,buff+sizeof(ACFindAllState),sizeof(FindallData)*state->m);
+}
+
+static void ac_serialize_find_all(ACFindAllState *state, char *buff)
+{
+ memcpy(buff,state,sizeof(ACFindAllState));
+ memcpy(buff+sizeof(ACFindAllState),state->out,sizeof(FindallData)*state->m);
+}
+
+static void ac_clean_find_all(ACFindAllState *state)
+{
+ if (state->out != NULL) {
+ erts_free(ERTS_ALC_T_TMP, state->out);
+ }
+#ifdef HARDDEBUG
+ state->out = NULL;
+ state->allocated = 0;
+#endif
+}
+
+#define SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(S) \
+ (sizeof(ACFindAllState)+(sizeof(FindallData)*(S).m))
+
+/*
+ * Differs to the find_first function in that it stores all matches and the values
+ * arte returned only in the state.
+ */
+static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack,
+ Uint *reductions)
+{
+ ACNode *q = state->q;
+ Uint i = state->pos;
+ Uint rstart;
+ ACNode *r;
+ Uint len = state->len;
+ Uint m = state->m, save_m;
+ Uint allocated = state->allocated;
+ FindallData *out = state->out;
+ register Uint reds = *reductions;
+
+
+ while (i < len) {
+ if (--reds == 0) {
+ state->q = q;
+ state->pos = i;
+ state->len = len;
+ state->m = m;
+ state->allocated = allocated;
+ state->out = out;
+ return AC_RESTART;
+ }
+ while (q->g[haystack[i]] == NULL && q->h != q) {
+ q = q->h;
+ }
+ if (q->g[haystack[i]] != NULL) {
+ q = q->g[haystack[i]];
+ }
+ ++i;
+ if (q->final) {
+ r = q;
+ while (r->final) {
+ while (r->final < 0)
+ r = r->h;
+#ifdef HARDDEBUG
+ erts_printf("Trying to add %u\n",(unsigned) r->final);
+#endif
+ rstart = i - r->d;
+ save_m = m;
+ while (m > 0 && (out[m-1].pos > rstart ||
+ (out[m-1].pos == rstart &&
+ out[m-1].len < r->d))) {
+#ifdef HARDDEBUG
+ erts_printf("Popping %u\n",(unsigned) out[m-1].id);
+#endif
+ --m;
+ }
+#ifdef HARDDEBUG
+ if (m > 0) {
+ erts_printf("Pos %u\n",out[m-1].pos);
+ erts_printf("Len %u\n",out[m-1].len);
+ }
+ erts_printf("Rstart %u\n",rstart);
+#endif
+ if (m == 0 || out[m-1].pos + out[m-1].len <= rstart) {
+ if (m >= allocated) {
+ if (!allocated) {
+ allocated = 10;
+ out = erts_alloc(ERTS_ALC_T_TMP,
+ sizeof(FindallData) * allocated);
+ } else {
+ allocated *= 2;
+ out = erts_realloc(ERTS_ALC_T_TMP, out,
+ sizeof(FindallData) *
+ allocated);
+ }
+ }
+ out[m].pos = rstart;
+ out[m].len = r->d;
+#ifdef HARDDEBUG
+ out[m].id = r->final;
+#endif
+ ++m;
+#ifdef HARDDEBUG
+ erts_printf("Pushing %u\n",(unsigned) out[m-1].id);
+#endif
+ } else {
+#ifdef HARDDEBUG
+ erts_printf("Backtracking %d steps\n",save_m - m);
+#endif
+ m = save_m;
+ }
+ r = r->h;
+ }
+ }
+ }
+ *reductions = reds;
+ state->m = m;
+ state->out = out;
+ return (m == 0) ? AC_NOT_FOUND : AC_OK;
+}
+
+/*
+ * Boyer Moore - most obviously implemented more or less exactly as
+ * Christian Charras and Thierry Lecroq describe it in "Handbook of
+ * Exact String-Matching Algorithms"
+ * http://www-igm.univ-mlv.fr/~lecroq/string/
+ */
+
+/*
+ * Call this to compute badshifts array
+ */
+static void compute_badshifts(BMData *bmd)
+{
+ Sint i;
+ Sint m = bmd->len;
+
+ for (i = 0; i < ALPHABET_SIZE; ++i) {
+ bmd->badshift[i] = m;
+ }
+ for (i = 0; i < m - 1; ++i) {
+ bmd->badshift[bmd->x[i]] = m - i - 1;
+ }
+}
+
+/* Helper for "compute_goodshifts" */
+static void compute_suffixes(byte *x, Sint m, Sint *suffixes)
+{
+ int f,g,i;
+
+ suffixes[m - 1] = m;
+
+ f = 0; /* To avoid use before set warning */
+
+ g = m - 1;
+
+ for (i = m - 2; i >= 0; --i) {
+ if (i > g && suffixes[i + m - 1 - f] < i - g) {
+ suffixes[i] = suffixes[i + m - 1 - f];
+ } else {
+ if (i < g) {
+ g = i;
+ }
+ f = i;
+ while ( g >= 0 && x[g] == x[g + m - 1 - f] ) {
+ --g;
+ }
+ suffixes[i] = f - g;
+ }
+ }
+}
+
+/*
+ * Call this to compute goodshift array
+ */
+static void compute_goodshifts(BMData *bmd)
+{
+ Sint m = bmd->len;
+ byte *x = bmd->x;
+ Sint i, j;
+ Sint *suffixes = erts_alloc(ERTS_ALC_T_TMP, m * sizeof(Sint));
+
+ compute_suffixes(x, m, suffixes);
+
+ for (i = 0; i < m; ++i) {
+ bmd->goodshift[i] = m;
+ }
+
+ j = 0;
+
+ for (i = m - 1; i >= -1; --i) {
+ if (i == -1 || suffixes[i] == i + 1) {
+ while (j < m - 1 - i) {
+ if (bmd->goodshift[j] == m) {
+ bmd->goodshift[j] = m - 1 - i;
+ }
+ ++j;
+ }
+ }
+ }
+ for (i = 0; i <= m - 2; ++i) {
+ bmd->goodshift[m - 1 - suffixes[i]] = m - 1 - i;
+ }
+ erts_free(ERTS_ALC_T_TMP, suffixes);
+}
+
+typedef struct {
+ Sint pos;
+ Sint len;
+} BMFindFirstState;
+
+#define BM_OK 0 /* used only for find_all */
+#define BM_NOT_FOUND -1
+#define BM_RESTART -2
+#define BM_LOOP_FACTOR 10 /* Should we have a higher value? */
+
+static void bm_init_find_first_match(BMFindFirstState *state, Sint startpos,
+ Uint len)
+{
+ state->pos = startpos;
+ state->len = (Sint) len;
+}
+
+
+static Sint bm_find_first_match(BMFindFirstState *state, BMData *bmd,
+ byte *haystack, Uint *reductions)
+{
+ Sint blen = bmd->len;
+ Sint len = state->len;
+ Sint *gs = bmd->goodshift;
+ Sint *bs = bmd->badshift;
+ byte *needle = bmd->x;
+ Sint i;
+ Sint j = state->pos;
+ register Uint reds = *reductions;
+
+ while (j <= len - blen) {
+ if (--reds == 0) {
+ state->pos = j;
+ return BM_RESTART;
+ }
+ for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i)
+ ;
+ if (i < 0) { /* found */
+ *reductions = reds;
+ return j;
+ }
+ j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i);
+ }
+ *reductions = reds;
+ return BM_NOT_FOUND;
+}
+
+typedef struct {
+ Sint pos;
+ Sint len;
+ Uint m;
+ Uint allocated;
+ FindallData *out;
+} BMFindAllState;
+
+static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len)
+{
+ state->pos = startpos;
+ state->len = (Sint) len;
+ state->m = 0;
+ state->allocated = 0;
+ state->out = NULL;
+}
+
+static void bm_restore_find_all(BMFindAllState *state, char *buff)
+{
+ memcpy(state,buff,sizeof(BMFindAllState));
+ state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) *
+ (state->allocated));
+ memcpy(state->out,buff+sizeof(BMFindAllState),
+ sizeof(FindallData)*state->m);
+}
+
+static void bm_serialize_find_all(BMFindAllState *state, char *buff)
+{
+ memcpy(buff,state,sizeof(BMFindAllState));
+ memcpy(buff+sizeof(BMFindAllState),state->out,
+ sizeof(FindallData)*state->m);
+}
+
+static void bm_clean_find_all(BMFindAllState *state)
+{
+ if (state->out != NULL) {
+ erts_free(ERTS_ALC_T_TMP, state->out);
+ }
+#ifdef HARDDEBUG
+ state->out = NULL;
+ state->allocated = 0;
+#endif
+}
+
+#define SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(S) \
+ (sizeof(BMFindAllState)+(sizeof(FindallData)*(S).m))
+
+/*
+ * Differs to the find_first function in that it stores all matches and the
+ * values are returned only in the state.
+ */
+static Sint bm_find_all_non_overlapping(BMFindAllState *state,
+ BMData *bmd, byte *haystack,
+ Uint *reductions)
+{
+ Sint blen = bmd->len;
+ Sint len = state->len;
+ Sint *gs = bmd->goodshift;
+ Sint *bs = bmd->badshift;
+ byte *needle = bmd->x;
+ Sint i;
+ Sint j = state->pos;
+ Uint m = state->m;
+ Uint allocated = state->allocated;
+ FindallData *out = state->out;
+ register Uint reds = *reductions;
+
+ while (j <= len - blen) {
+ if (--reds == 0) {
+ state->pos = j;
+ state->m = m;
+ state->allocated = allocated;
+ state->out = out;
+ return BM_RESTART;
+ }
+ for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i)
+ ;
+ if (i < 0) { /* found */
+ if (m >= allocated) {
+ if (!allocated) {
+ allocated = 10;
+ out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * allocated);
+ } else {
+ allocated *= 2;
+ out = erts_realloc(ERTS_ALC_T_TMP, out,
+ sizeof(FindallData) * allocated);
+ }
+ }
+ out[m].pos = j;
+ out[m].len = blen;
+ ++m;
+ j += blen;
+ } else {
+ j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i);
+ }
+ }
+ state->m = m;
+ state->out = out;
+ *reductions = reds;
+ return (m == 0) ? BM_NOT_FOUND : BM_OK;
+}
+
+/*
+ * Interface functions (i.e. "bif's")
+ */
+
+/*
+ * Search functionality interfaces
+ */
+
+static int do_binary_match_compile(Eterm argument, Eterm *tag, Binary **binp)
+{
+ Eterm t, b, comp_term = NIL;
+ Uint characters;
+ Uint words;
+
+ characters = 0;
+ words = 0;
+
+ if (is_list(argument)) {
+ t = argument;
+ while (is_list(t)) {
+ b = CAR(list_val(t));
+ t = CDR(list_val(t));
+ if (!is_binary(b)) {
+ goto badarg;
+ }
+ if (binary_bitsize(b) != 0) {
+ goto badarg;
+ }
+ ++words;
+ characters += binary_size(b);
+ }
+ if (is_not_nil(t)) {
+ goto badarg;
+ }
+ if (words > 1) {
+ comp_term = argument;
+ } else {
+ comp_term = CAR(list_val(argument));
+ }
+ } else if (is_binary(argument)) {
+ if (binary_bitsize(argument) != 0) {
+ goto badarg;
+ }
+ words = 1;
+ comp_term = argument;
+ characters = binary_size(argument);
+ }
+
+ if (characters == 0) {
+ goto badarg;
+ }
+ ASSERT(words > 0);
+
+ if (words == 1) {
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
+ MyAllocator my;
+ BMData *bmd;
+ Binary *bin;
+
+ ERTS_GET_BINARY_BYTES(comp_term, bytes, bitoffs, bitsize);
+ if (bitoffs != 0) {
+ bytes = erts_get_aligned_binary_bytes(comp_term, &temp_alloc);
+ }
+ bmd = create_bmdata(&my, bytes, characters, &bin);
+ compute_badshifts(bmd);
+ compute_goodshifts(bmd);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ CHECK_ALLOCATOR(my);
+ *tag = am_bm;
+ *binp = bin;
+ return 0;
+ } else {
+ ACTrie *act;
+ MyAllocator my;
+ ACNode **qbuff;
+ Binary *bin;
+
+ act = create_acdata(&my, characters, &qbuff, &bin);
+ t = comp_term;
+ while (is_list(t)) {
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
+ b = CAR(list_val(t));
+ t = CDR(list_val(t));
+ ERTS_GET_BINARY_BYTES(b, bytes, bitoffs, bitsize);
+ if (bitoffs != 0) {
+ bytes = erts_get_aligned_binary_bytes(b, &temp_alloc);
+ }
+ ac_add_one_pattern(&my,act,bytes,binary_size(b));
+ erts_free_aligned_binary_bytes(temp_alloc);
+ }
+ ac_compute_failure_functions(act,qbuff);
+ CHECK_ALLOCATOR(my);
+ erts_free(ERTS_ALC_T_TMP,qbuff);
+ *tag = am_ac;
+ *binp = bin;
+ return 0;
+ }
+ badarg:
+ return -1;
+}
+
+BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1)
+{
+ Binary *bin;
+ Eterm tag, ret;
+ Eterm *hp;
+
+ if (do_binary_match_compile(BIF_ARG_1,&tag,&bin)) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+ hp = HAlloc(BIF_P, PROC_BIN_SIZE+3);
+ ret = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin);
+ ret = TUPLE2(hp, tag, ret);
+ BIF_RET(ret);
+}
+
+#define DO_BIN_MATCH_OK 0
+#define DO_BIN_MATCH_BADARG -1
+#define DO_BIN_MATCH_RESTART -2
+
+static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend,
+ Eterm type, Binary *bin, Eterm state_term,
+ Eterm *res_term)
+{
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
+
+ ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
+ if (bitsize != 0) {
+ goto badarg;
+ }
+ if (bitoffs != 0) {
+ bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
+ }
+ if (state_term != NIL) {
+ Eterm *ptr = big_val(state_term);
+ type = ptr[1];
+ }
+
+ if (type == am_bm) {
+ BMData *bm;
+ Sint pos;
+ Eterm ret;
+ Eterm *hp;
+ BMFindFirstState state;
+ Uint reds = get_reds(p, BM_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_bm_data(bm);
+#endif
+ if (state_term == NIL) {
+ bm_init_find_first_match(&state, hsstart, hsend);
+ } else {
+ Eterm *ptr = big_val(state_term);
+ memcpy(&state,ptr+2,sizeof(state));
+ }
+#ifdef HARDDEBUG
+ erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
+ state.len);
+#endif
+ pos = bm_find_first_match(&state, bm, bytes, &reds);
+ if (pos == BM_NOT_FOUND) {
+ ret = am_nomatch;
+ } else if (pos == BM_RESTART) {
+ int x = (sizeof(BMFindFirstState) / sizeof(Eterm)) +
+ !!(sizeof(BMFindFirstState) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap bm!\n");
+#endif
+ hp = HAlloc(p,x+2);
+ hp[0] = make_pos_bignum_header(x+1);
+ hp[1] = type;
+ memcpy(hp+2,&state,sizeof(state));
+ *res_term = make_big(hp);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ Eterm erlen = erts_make_integer((Uint) bm->len, p);
+ ret = erts_make_integer(pos,p);
+ hp = HAlloc(p,3);
+ ret = TUPLE2(hp, ret, erlen);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+ *res_term = ret;
+ return DO_BIN_MATCH_OK;
+ } else if (type == am_ac) {
+ ACTrie *act;
+ Uint pos, rlen;
+ int acr;
+ ACFindFirstState state;
+ Eterm ret;
+ Eterm *hp;
+ Uint reds = get_reds(p, AC_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_ac_trie(act);
+#endif
+ if (state_term == NIL) {
+ ac_init_find_first_match(&state, act, hsstart, hsend);
+ } else {
+ Eterm *ptr = big_val(state_term);
+ memcpy(&state,ptr+2,sizeof(state));
+ }
+ acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
+ if (acr == AC_NOT_FOUND) {
+ ret = am_nomatch;
+ } else if (acr == AC_RESTART) {
+ int x = (sizeof(state) / sizeof(Eterm)) +
+ !!(sizeof(BMFindFirstState) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap ac!\n");
+#endif
+ hp = HAlloc(p,x+2);
+ hp[0] = make_pos_bignum_header(x+1);
+ hp[1] = type;
+ memcpy(hp+2,&state,sizeof(state));
+ *res_term = make_big(hp);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ Eterm epos = erts_make_integer(pos+hsstart,p);
+ Eterm erlen = erts_make_integer(rlen,p);
+ hp = HAlloc(p,3);
+ ret = TUPLE2(hp, epos, erlen);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+ *res_term = ret;
+ return DO_BIN_MATCH_OK;
+ }
+ badarg:
+ return DO_BIN_MATCH_BADARG;
+}
+
+static int do_binary_matches(Process *p, Eterm subject, Uint hsstart,
+ Uint hsend, Eterm type, Binary *bin,
+ Eterm state_term, Eterm *res_term)
+{
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
+
+ ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
+ if (bitsize != 0) {
+ goto badarg;
+ }
+ if (bitoffs != 0) {
+ bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
+ }
+ if (state_term != NIL) {
+ Eterm *ptr = big_val(state_term);
+ type = ptr[1];
+ }
+
+ if (type == am_bm) {
+ BMData *bm;
+ Sint pos;
+ Eterm ret,tpl;
+ Eterm *hp;
+ BMFindAllState state;
+ Uint reds = get_reds(p, BM_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_bm_data(bm);
+#endif
+ if (state_term == NIL) {
+ bm_init_find_all(&state, hsstart, hsend);
+ } else {
+ Eterm *ptr = big_val(state_term);
+ bm_restore_find_all(&state,(char *) (ptr+2));
+ }
+
+ pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
+ if (pos == BM_NOT_FOUND) {
+ ret = NIL;
+ } else if (pos == BM_RESTART) {
+ int x =
+ (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap bm!\n");
+#endif
+ hp = HAlloc(p,x+2);
+ hp[0] = make_pos_bignum_header(x+1);
+ hp[1] = type;
+ bm_serialize_find_all(&state, (char *) (hp+2));
+ *res_term = make_big(hp);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ bm_clean_find_all(&state);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ FindallData *fad = state.out;
+ int i;
+ for (i = 0; i < state.m; ++i) {
+ fad[i].epos = erts_make_integer(fad[i].pos,p);
+ fad[i].elen = erts_make_integer(fad[i].len,p);
+ }
+ hp = HAlloc(p,state.m * (3 + 2));
+ ret = NIL;
+ for (i = state.m - 1; i >= 0; --i) {
+ tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
+ hp +=3;
+ ret = CONS(hp,tpl,ret);
+ hp += 2;
+ }
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ bm_clean_find_all(&state);
+ BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+ *res_term = ret;
+ return DO_BIN_MATCH_OK;
+ } else if (type == am_ac) {
+ ACTrie *act;
+ int acr;
+ ACFindAllState state;
+ Eterm ret,tpl;
+ Eterm *hp;
+ Uint reds = get_reds(p, AC_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_ac_trie(act);
+#endif
+ if (state_term == NIL) {
+ ac_init_find_all(&state, act, hsstart, hsend);
+ } else {
+ Eterm *ptr = big_val(state_term);
+ ac_restore_find_all(&state,(char *) (ptr+2));
+ }
+ acr = ac_find_all_non_overlapping(&state, bytes, &reds);
+ if (acr == AC_NOT_FOUND) {
+ ret = NIL;
+ } else if (acr == AC_RESTART) {
+ int x =
+ (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap ac!\n");
+#endif
+ hp = HAlloc(p,x+2);
+ hp[0] = make_pos_bignum_header(x+1);
+ hp[1] = type;
+ ac_serialize_find_all(&state, (char *) (hp+2));
+ *res_term = make_big(hp);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ ac_clean_find_all(&state);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ FindallData *fad = state.out;
+ int i;
+ for (i = 0; i < state.m; ++i) {
+ fad[i].epos = erts_make_integer(fad[i].pos,p);
+ fad[i].elen = erts_make_integer(fad[i].len,p);
+ }
+ hp = HAlloc(p,state.m * (3 + 2));
+ ret = NIL;
+ for (i = state.m - 1; i >= 0; --i) {
+ tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
+ hp +=3;
+ ret = CONS(hp,tpl,ret);
+ hp += 2;
+ }
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ ac_clean_find_all(&state);
+ BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+ *res_term = ret;
+ return DO_BIN_MATCH_OK;
+ }
+ badarg:
+ return DO_BIN_MATCH_BADARG;
+}
+
+static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
+{
+ Eterm *tp;
+ Uint pos;
+ Sint len;
+ if (l == ((Eterm) 0) || l == NIL) {
+ /* Invalid term or NIL, we're called from binary_match(es)_2 or
+ have no options*/
+ *posp = 0;
+ *endp = binary_size(bin);
+ return 0;
+ } else if (is_list(l)) {
+ while(is_list(l)) {
+ Eterm t = CAR(list_val(l));
+ Uint orig_size;
+ if (!is_tuple(t)) {
+ goto badarg;
+ }
+ tp = tuple_val(t);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ if (tp[1] != am_scope || is_not_tuple(tp[2])) {
+ goto badarg;
+ }
+ tp = tuple_val(tp[2]);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ if (!term_to_Uint(tp[1], &pos)) {
+ goto badarg;
+ }
+ if (!term_to_Sint(tp[2], &len)) {
+ goto badarg;
+ }
+ if (len < 0) {
+ Sint lentmp = -len;
+ /* overflow */
+ if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ goto badarg;
+ }
+ len = lentmp;
+ pos -= len;
+ }
+ /* overflow */
+ if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+ goto badarg;
+ }
+ *endp = len + pos;
+ *posp = pos;
+ if ((orig_size = binary_size(bin)) < pos ||
+ orig_size < (*endp)) {
+ goto badarg;
+ }
+ l = CDR(list_val(l));
+ }
+ return 0;
+ } else {
+ badarg:
+ return 1;
+ }
+}
+
+static BIF_RETTYPE binary_match_trap(BIF_ALIST_3)
+{
+ int runres;
+ Eterm result;
+ Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+ runres = do_binary_match(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
+ if (runres == DO_BIN_MATCH_OK) {
+ BIF_RET(result);
+ } else {
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result,
+ BIF_ARG_3);
+ }
+}
+
+static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3)
+{
+ int runres;
+ Eterm result;
+ Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+ runres = do_binary_matches(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
+ if (runres == DO_BIN_MATCH_OK) {
+ BIF_RET(result);
+ } else {
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result,
+ BIF_ARG_3);
+ }
+}
+
+BIF_RETTYPE binary_match_3(BIF_ALIST_3)
+{
+ Uint hsstart;
+ Uint hsend;
+ Eterm *tp;
+ Eterm type;
+ Binary *bin;
+ Eterm bin_term = NIL;
+ int runres;
+ Eterm result;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ goto badarg;
+ }
+ if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) {
+ goto badarg;
+ }
+ if (hsend == 0) {
+ BIF_RET(am_nomatch);
+ }
+ if (is_tuple(BIF_ARG_2)) {
+ tp = tuple_val(BIF_ARG_2);
+ if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
+ goto badarg;
+ }
+ if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
+ !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
+ goto badarg;
+ }
+ type = tp[1];
+ bin = ((ProcBin *) binary_val(tp[2]))->val;
+ if (type == am_bm &&
+ ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
+ goto badarg;
+ }
+ if (type == am_ac &&
+ ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
+ goto badarg;
+ }
+ bin_term = tp[2];
+ } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) {
+ goto badarg;
+ }
+ runres = do_binary_match(BIF_P,BIF_ARG_1,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);
+ } else if (bin_term == NIL) {
+ erts_bin_free(bin);
+ }
+ switch (runres) {
+ 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);
+ default:
+ goto badarg;
+ }
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
+{
+ Uint hsstart, hsend;
+ Eterm *tp;
+ Eterm type;
+ Binary *bin;
+ Eterm bin_term = NIL;
+ int runres;
+ Eterm result;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ goto badarg;
+ }
+ if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) {
+ goto badarg;
+ }
+ if (hsend == 0) {
+ BIF_RET(am_nomatch);
+ }
+ if (is_tuple(BIF_ARG_2)) {
+ tp = tuple_val(BIF_ARG_2);
+ if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
+ goto badarg;
+ }
+ if (((tp[1] != am_bm) && (tp[1] != am_ac)) ||
+ !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
+ goto badarg;
+ }
+ type = tp[1];
+ bin = ((ProcBin *) binary_val(tp[2]))->val;
+ if (type == am_bm &&
+ ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
+ goto badarg;
+ }
+ if (type == am_ac &&
+ ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
+ goto badarg;
+ }
+ bin_term = tp[2];
+ } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) {
+ goto badarg;
+ }
+ runres = do_binary_matches(BIF_P,BIF_ARG_1,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);
+ } else if (bin_term == NIL) {
+ erts_bin_free(bin);
+ }
+ switch (runres) {
+ 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,
+ bin_term);
+ default:
+ goto badarg;
+ }
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+
+BIF_RETTYPE binary_match_2(BIF_ALIST_2)
+{
+ return binary_match_3(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));
+}
+
+
+BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
+{
+ Uint pos;
+ Sint len;
+ size_t orig_size;
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ Eterm* hp;
+ ErlSubBin* sb;
+
+ if (is_not_binary(binary)) {
+ goto badarg;
+ }
+ if (!term_to_Uint(epos, &pos)) {
+ goto badarg;
+ }
+ if (!term_to_Sint(elen, &len)) {
+ goto badarg;
+ }
+ if (len < 0) {
+ Sint lentmp = -len;
+ /* overflow */
+ if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ goto badarg;
+ }
+ len = lentmp;
+ if (len > pos) {
+ goto badarg;
+ }
+ pos -= len;
+ }
+ /* overflow */
+ if ((pos + len) < pos || (len > 0 && (pos + len) == pos)){
+ goto badarg;
+ }
+ if ((orig_size = binary_size(binary)) < pos ||
+ orig_size < (pos + len)) {
+ goto badarg;
+ }
+
+
+
+ hp = HAlloc(p, ERL_SUB_BIN_SIZE);
+
+ ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size);
+ sb = (ErlSubBin *) hp;
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->size = len;
+ sb->offs = offset + pos;
+ sb->orig = orig;
+ sb->bitoffs = bit_offset;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+
+ BIF_RET(make_binary(sb));
+
+ badarg:
+ BIF_ERROR(p, BADARG);
+}
+
+#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
+
+BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple)
+{
+ Uint pos;
+ Sint len;
+ size_t orig_size;
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ Eterm* hp;
+ ErlSubBin* sb;
+ Eterm binary;
+ Eterm *tp;
+ Eterm epos, elen;
+ int extra_args;
+
+
+ if (range_is_tuple) {
+ Eterm tpl = reg[live];
+ extra_args = 1;
+ if (is_not_tuple(tpl)) {
+ goto badarg;
+ }
+ tp = tuple_val(tpl);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+
+ epos = tp[1];
+ elen = tp[2];
+ } else {
+ extra_args = 2;
+ epos = reg[live-1];
+ elen = reg[live];
+ }
+ binary = reg[live-extra_args];
+
+ if (is_not_binary(binary)) {
+ goto badarg;
+ }
+ if (!term_to_Uint(epos, &pos)) {
+ goto badarg;
+ }
+ if (!term_to_Sint(elen, &len)) {
+ goto badarg;
+ }
+ if (len < 0) {
+ Sint lentmp = -len;
+ /* overflow */
+ if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ goto badarg;
+ }
+ len = lentmp;
+ if (len > pos) {
+ goto badarg;
+ }
+ pos -= len;
+ }
+ /* overflow */
+ if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+ goto badarg;
+ }
+ if ((orig_size = binary_size(binary)) < pos ||
+ orig_size < (pos + len)) {
+ goto badarg;
+ }
+
+ if (ERTS_NEED_GC(p, ERL_SUB_BIN_SIZE)) {
+ erts_garbage_collect(p, ERL_SUB_BIN_SIZE, reg, live+1-extra_args); /* I don't need the tuple
+ or indices any more */
+ binary = reg[live-extra_args];
+ }
+
+ hp = p->htop;
+ p->htop += ERL_SUB_BIN_SIZE;
+
+ ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size);
+
+ sb = (ErlSubBin *) hp;
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->size = len;
+ sb->offs = offset + pos;
+ sb->orig = orig;
+ sb->bitoffs = bit_offset;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+
+ BIF_RET(make_binary(sb));
+
+ badarg:
+ BIF_ERROR(p, BADARG);
+}
+/*************************************************************
+ * The actual guard BIFs are in erl_bif_guard.c
+ * but the implementation of both the non-gc and the gc
+ * variants are here. Note that the functions are named so that they do
+ * not clash with the guard bif's erlang:binary_part/2,3
+ *************************************************************/
+
+BIF_RETTYPE binary_binary_part_3(BIF_ALIST_3)
+{
+ return erts_binary_part(BIF_P,BIF_ARG_1,BIF_ARG_2, BIF_ARG_3);
+}
+
+BIF_RETTYPE binary_binary_part_2(BIF_ALIST_2)
+{
+ Eterm *tp;
+ if (is_not_tuple(BIF_ARG_2)) {
+ goto badarg;
+ }
+ tp = tuple_val(BIF_ARG_2);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ return erts_binary_part(BIF_P,BIF_ARG_1,tp[1], tp[2]);
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+typedef struct {
+ int type; /* CL_TYPE_XXX */
+ byte *temp_alloc; /* Used for erts_get/free_aligned, i.e. CL_TYPE_ALIGNED */
+ unsigned char *buff; /* Used for all types, malloced if CL_TYPE_HEAP */
+ Uint bufflen; /* The length (in bytes) of buffer */
+} CommonData;
+
+#define COMMON_LOOP_FACTOR 10
+
+#define DIRECTION_PREFIX 0
+#define DIRECTION_SUFFIX 1
+
+#define CL_OK 0
+#define CL_RESTART 1
+
+/* The type field in the above structure */
+#define CL_TYPE_EMPTY 0 /* End of array */
+#define CL_TYPE_HEAP 1
+#define CL_TYPE_ALIGNED 2
+#define CL_TYPE_COMMON 3 /* emacsulated */
+#define CL_TYPE_HEAP_NOALLOC 4 /* Will need allocating when trapping */
+
+
+static int do_search_forward(CommonData *cd, Uint *posp, Uint *redsp)
+{
+ Uint pos = *posp;
+ Sint reds = (Sint) *redsp;
+ int i;
+ unsigned char current = 0;
+
+ for(;;) {
+ for(i = 0; cd[i].type != CL_TYPE_EMPTY; ++i) {
+ if (pos >= cd[i].bufflen) {
+ *posp = pos;
+ if (reds > 0) {
+ *redsp = (Uint) reds;
+ } else {
+ *redsp = 0;
+ }
+ return CL_OK;
+ }
+ if (i == 0) {
+ current = cd[i].buff[pos];
+ } else {
+ if (cd[i].buff[pos] != current) {
+ *posp = pos;
+ if (reds > 0) {
+ *redsp = (Uint) reds;
+ } else {
+ *redsp = 0;
+ }
+ return CL_OK;
+ }
+ }
+ --reds;
+ }
+ ++pos;
+ if (reds <= 0) {
+ *posp = pos;
+ *redsp = 0;
+ return CL_RESTART;
+ }
+ }
+}
+static int do_search_backward(CommonData *cd, Uint *posp, Uint *redsp)
+{
+ Uint pos = *posp;
+ Sint reds = (Sint) *redsp;
+ int i;
+ unsigned char current = 0;
+
+ for(;;) {
+ for(i = 0; cd[i].type != CL_TYPE_EMPTY; ++i) {
+ if (pos >= cd[i].bufflen) {
+ *posp = pos;
+ if (reds > 0) {
+ *redsp = (Uint) reds;
+ } else {
+ *redsp = 0;
+ }
+ return CL_OK;
+ }
+ if (i == 0) {
+ current = cd[i].buff[cd[i].bufflen - 1 - pos];
+ } else {
+ if (cd[i].buff[cd[i].bufflen - 1 - pos] != current) {
+ *posp = pos;
+ if (reds > 0) {
+ *redsp = (Uint) reds;
+ } else {
+ *redsp = 0;
+ }
+ return CL_OK;
+ }
+ }
+ --reds;
+ }
+ ++pos;
+ if (reds <= 0) {
+ *posp = pos;
+ *redsp = 0;
+ return CL_RESTART;
+ }
+ }
+}
+
+static void cleanup_common_data(Binary *bp)
+{
+ int i;
+ CommonData *cd;
+ cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bp);
+ for (i=0;cd[i].type != CL_TYPE_EMPTY;++i) {
+ switch (cd[i].type) {
+ case CL_TYPE_HEAP:
+ erts_free(ERTS_ALC_T_BINARY_BUFFER,cd[i].buff);
+ break;
+ case CL_TYPE_ALIGNED:
+ erts_free_aligned_binary_bytes_extra(cd[i].temp_alloc, ERTS_ALC_T_BINARY_BUFFER);
+ break;
+ default:
+ break;
+ }
+ }
+ return;
+}
+
+static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction)
+{
+ Eterm l = list;
+ int n = 0;
+ Binary *mb;
+ CommonData *cd;
+ int i = 0;
+ Uint reds = get_reds(p, COMMON_LOOP_FACTOR);
+ Uint save_reds = reds;
+ int res;
+ Export *trapper;
+ Uint pos;
+ Eterm epos;
+ Eterm *hp;
+ Eterm bin_term;
+ Eterm b;
+
+ /* First just count the number of binaries */
+ while (is_list(l)) {
+ b = CAR(list_val(l));
+ if (!is_binary(b)) {
+ goto badarg;
+ }
+ ++n;
+ l = CDR(list_val(l));
+ }
+ if (l != NIL || n == 0) {
+ goto badarg;
+ }
+
+ /* OK, now create a buffer of the right size, we can do a magic binary right away,
+ that's not too costly. */
+ mb = erts_create_magic_binary((n+1)*sizeof(CommonData),cleanup_common_data);
+ cd = (CommonData *) ERTS_MAGIC_BIN_DATA(mb);
+ l = list;
+ while (is_list(l)) {
+ Uint bitoffs;
+ Uint bitsize;
+ Uint offset;
+ Eterm real_bin;
+ ProcBin* pb;
+
+ cd[i].type = CL_TYPE_EMPTY;
+ b = CAR(list_val(l));
+ ERTS_GET_REAL_BIN(b, real_bin, offset, bitoffs, bitsize);
+ if (bitsize != 0) {
+ erts_bin_free(mb);
+ goto badarg;
+ }
+ cd[i].bufflen = binary_size(b);
+ cd[i].temp_alloc = NULL;
+ if (*(binary_val(real_bin)) == HEADER_PROC_BIN) {
+ pb = (ProcBin *) binary_val(real_bin);
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+ cd[i].buff = erts_get_aligned_binary_bytes_extra(b, &(cd[i].temp_alloc),
+ ERTS_ALC_T_BINARY_BUFFER,0);
+ cd[i].type = (cd[i].temp_alloc != NULL) ? CL_TYPE_ALIGNED : CL_TYPE_COMMON;
+ } else { /* Heap binary */
+ cd[i].buff = erts_get_aligned_binary_bytes_extra(b, &(cd[i].temp_alloc),
+ ERTS_ALC_T_BINARY_BUFFER,0);
+ /* CL_TYPE_HEAP_NOALLOC means you have to copy if trapping */
+ cd[i].type = (cd[i].temp_alloc != NULL) ? CL_TYPE_ALIGNED : CL_TYPE_HEAP_NOALLOC;
+ }
+ ++i;
+ l = CDR(list_val(l));
+ }
+ cd[i].type = CL_TYPE_EMPTY;
+#if defined(DEBUG) || defined(VALGRIND)
+ cd[i].temp_alloc = NULL;
+ cd[i].buff = NULL;
+ cd[i].bufflen = 0;
+#endif
+
+ pos = 0;
+ if (direction == DIRECTION_PREFIX) {
+ trapper = &binary_longest_prefix_trap_export;
+ res = do_search_forward(cd,&pos,&reds);
+ } else {
+ ASSERT(direction == DIRECTION_SUFFIX);
+ trapper = &binary_longest_suffix_trap_export;
+ res = do_search_backward(cd,&pos,&reds);
+ }
+ epos = erts_make_integer(pos,p);
+ if (res == CL_OK) {
+ erts_bin_free(mb);
+ BUMP_REDS(p, (save_reds - reds) / COMMON_LOOP_FACTOR);
+ BIF_RET(epos);
+ } else {
+ ASSERT(res == CL_RESTART);
+ /* Copy all heap binaries that are not already copied (aligned) */
+ for(i = 0; i < n; ++i) {
+ if (cd[i].type == CL_TYPE_HEAP_NOALLOC) {
+ unsigned char *tmp = cd[i].buff;
+ cd[i].buff = erts_alloc(ERTS_ALC_T_BINARY_BUFFER, cd[i].bufflen);
+ memcpy(cd[i].buff,tmp,cd[i].bufflen);
+ cd[i].type = CL_TYPE_HEAP;
+ }
+ }
+ hp = HAlloc(p, PROC_BIN_SIZE);
+ bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb);
+ BUMP_ALL_REDS(p);
+ BIF_TRAP3(trapper, p, bin_term, epos,list);
+ }
+ badarg:
+ BIF_ERROR(p,BADARG);
+}
+
+static BIF_RETTYPE do_longest_common_trap(Process *p, Eterm bin_term, Eterm current_pos,
+ Eterm orig_list, int direction)
+{
+ Uint reds = get_reds(p, COMMON_LOOP_FACTOR);
+ Uint save_reds = reds;
+ Uint pos;
+ Binary *bin;
+ CommonData *cd;
+ int res;
+ Eterm epos;
+ Export *trapper;
+
+#ifdef DEBUG
+ int r;
+ r = term_to_Uint(current_pos, &pos);
+ ASSERT(r != 0);
+#else
+ term_to_Uint(current_pos, &pos);
+#endif
+ ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin_term));
+ bin = ((ProcBin *) binary_val(bin_term))->val;
+ cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bin);
+ if (direction == DIRECTION_PREFIX) {
+ trapper = &binary_longest_prefix_trap_export;
+ res = do_search_forward(cd,&pos,&reds);
+ } else {
+ ASSERT(direction == DIRECTION_SUFFIX);
+ trapper = &binary_longest_suffix_trap_export;
+ res = do_search_backward(cd,&pos,&reds);
+ }
+ epos = erts_make_integer(pos,p);
+ if (res == CL_OK) {
+ BUMP_REDS(p, (save_reds - reds) / COMMON_LOOP_FACTOR);
+ BIF_RET(epos);
+ } else {
+ ASSERT(res == CL_RESTART);
+ /* Copy all heap binaries that are not already copied (aligned) */
+ BUMP_ALL_REDS(p);
+ BIF_TRAP3(trapper, p, bin_term, epos, orig_list);
+ }
+}
+
+static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3)
+{
+ return do_longest_common_trap(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3,DIRECTION_PREFIX);
+}
+
+static BIF_RETTYPE binary_longest_suffix_trap(BIF_ALIST_3)
+{
+ return do_longest_common_trap(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3,DIRECTION_SUFFIX);
+}
+
+BIF_RETTYPE binary_longest_common_prefix_1(BIF_ALIST_1)
+{
+ return do_longest_common(BIF_P,BIF_ARG_1,DIRECTION_PREFIX);
+}
+
+BIF_RETTYPE binary_longest_common_suffix_1(BIF_ALIST_1)
+{
+ return do_longest_common(BIF_P,BIF_ARG_1,DIRECTION_SUFFIX);
+}
+
+BIF_RETTYPE binary_first_1(BIF_ALIST_1)
+{
+ byte* bytes;
+ Uint byte_size;
+ Uint bit_offs;
+ Uint bit_size;
+ Uint res;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ goto badarg;
+ }
+ byte_size = binary_size(BIF_ARG_1);
+ if (!byte_size) {
+ goto badarg;
+ }
+ ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
+ if (bit_size) {
+ goto badarg;
+ }
+ if (bit_offs) {
+ res = ((((Uint) bytes[0]) << bit_offs) | (((Uint) bytes[1]) >> (8-bit_offs))) & 0xFF;
+ } else {
+ res = bytes[0];
+ }
+ BIF_RET(make_small(res));
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+BIF_RETTYPE binary_last_1(BIF_ALIST_1)
+{
+ byte* bytes;
+ Uint byte_size;
+ Uint bit_offs;
+ Uint bit_size;
+ Uint res;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ goto badarg;
+ }
+ byte_size = binary_size(BIF_ARG_1);
+ if (!byte_size) {
+ goto badarg;
+ }
+ ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
+ if (bit_size) {
+ goto badarg;
+ }
+ if (bit_offs) {
+ res = ((((Uint) bytes[byte_size-1]) << bit_offs) |
+ (((Uint) bytes[byte_size]) >> (8-bit_offs))) & 0xFF;
+ } else {
+ res = bytes[byte_size-1];
+ }
+ BIF_RET(make_small(res));
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+BIF_RETTYPE binary_at_2(BIF_ALIST_2)
+{
+ byte* bytes;
+ Uint byte_size;
+ Uint bit_offs;
+ Uint bit_size;
+ Uint res;
+ Uint index;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ goto badarg;
+ }
+ byte_size = binary_size(BIF_ARG_1);
+ if (!byte_size) {
+ goto badarg;
+ }
+ if (!term_to_Uint(BIF_ARG_2, &index)) {
+ goto badarg;
+ }
+ if (index >= byte_size) {
+ goto badarg;
+ }
+ ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
+ if (bit_size) {
+ goto badarg;
+ }
+ if (bit_offs) {
+ res = ((((Uint) bytes[index]) << bit_offs) |
+ (((Uint) bytes[index+1]) >> (8-bit_offs))) & 0xFF;
+ } else {
+ res = bytes[index];
+ }
+ BIF_RET(make_small(res));
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+#define BIN_TO_LIST_OK 0
+#define BIN_TO_LIST_TRAP 1
+/* No badarg, checked before call */
+
+#define BIN_TO_LIST_LOOP_FACTOR 10
+
+static int do_bin_to_list(Process *p, byte *bytes, Uint bit_offs,
+ Uint start, Sint *lenp, Eterm *termp)
+{
+ Uint reds = get_reds(p, BIN_TO_LIST_LOOP_FACTOR); /* reds can never be 0 */
+ Uint len = *lenp;
+ Uint loops;
+ Eterm *hp;
+ Eterm term = *termp;
+ Uint n;
+
+ ASSERT(reds > 0);
+
+ loops = MIN(reds,len);
+
+ BUMP_REDS(p, loops / BIN_TO_LIST_LOOP_FACTOR);
+
+ hp = HAlloc(p,2*loops);
+ while (loops--) {
+ --len;
+ if (bit_offs) {
+ n = ((((Uint) bytes[start+len]) << bit_offs) |
+ (((Uint) bytes[start+len+1]) >> (8-bit_offs))) & 0xFF;
+ } else {
+ n = bytes[start+len];
+ }
+
+ term = CONS(hp,make_small(n),term);
+ hp +=2;
+ }
+ *termp = term;
+ *lenp = len;
+ if (len) {
+ BUMP_ALL_REDS(p);
+ return BIN_TO_LIST_TRAP;
+ }
+ return BIN_TO_LIST_OK;
+}
+
+
+static BIF_RETTYPE do_trap_bin_to_list(Process *p, Eterm binary,
+ Uint start, Sint len, Eterm sofar)
+{
+ Eterm *hp;
+ Eterm blob;
+
+ hp = HAlloc(p,3);
+ hp[0] = make_pos_bignum_header(2);
+ hp[1] = start;
+ hp[2] = (Uint) len;
+ blob = make_big(hp);
+ BIF_TRAP3(&binary_bin_to_list_trap_export, p, binary, blob, sofar);
+}
+
+static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3)
+{
+ Eterm *ptr;
+ Uint start;
+ Sint len;
+ byte *bytes;
+ Uint bit_offs;
+ Uint bit_size;
+ Eterm res = BIF_ARG_3;
+
+ ptr = big_val(BIF_ARG_2);
+ start = ptr[1];
+ len = (Sint) ptr[2];
+
+ ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
+ if (do_bin_to_list(BIF_P, bytes, bit_offs, start, &len, &res) ==
+ BIN_TO_LIST_OK) {
+ BIF_RET(res);
+ }
+ return do_trap_bin_to_list(BIF_P,BIF_ARG_1,start,len,res);
+}
+
+static BIF_RETTYPE binary_bin_to_list_common(Process *p,
+ Eterm bin,
+ Eterm epos,
+ Eterm elen)
+{
+ Uint pos;
+ Sint len;
+ size_t sz;
+ byte *bytes;
+ Uint bit_offs;
+ Uint bit_size;
+ Eterm res = NIL;
+
+ if (is_not_binary(bin)) {
+ goto badarg;
+ }
+ if (!term_to_Uint(epos, &pos)) {
+ goto badarg;
+ }
+ if (!term_to_Sint(elen, &len)) {
+ goto badarg;
+ }
+ if (len < 0) {
+ Sint lentmp = -len;
+ /* overflow */
+ if (lentmp == len || lentmp < 0 || -lentmp != len) {
+ goto badarg;
+ }
+ len = lentmp;
+ if (len > pos) {
+ goto badarg;
+ }
+ pos -= len;
+ }
+ /* overflow */
+ if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+ goto badarg;
+ }
+ sz = binary_size(bin);
+
+ if (pos+len > sz) {
+ goto badarg;
+ }
+ ERTS_GET_BINARY_BYTES(bin,bytes,bit_offs,bit_size);
+ if (bit_size != 0) {
+ goto badarg;
+ }
+ if(do_bin_to_list(p, bytes, bit_offs, pos, &len, &res) ==
+ BIN_TO_LIST_OK) {
+ BIF_RET(res);
+ }
+ return do_trap_bin_to_list(p,bin,pos,len,res);
+
+ badarg:
+ BIF_ERROR(p,BADARG);
+}
+
+BIF_RETTYPE binary_bin_to_list_3(BIF_ALIST_3)
+{
+ return binary_bin_to_list_common(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3);
+}
+
+BIF_RETTYPE binary_bin_to_list_2(BIF_ALIST_2)
+{
+ Eterm *tp;
+
+ if (is_not_tuple(BIF_ARG_2)) {
+ goto badarg;
+ }
+ tp = tuple_val(BIF_ARG_2);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ return binary_bin_to_list_common(BIF_P,BIF_ARG_1,tp[1],tp[2]);
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1)
+{
+ Uint pos = 0;
+ Sint len;
+ byte *bytes;
+ Uint bit_offs;
+ Uint bit_size;
+ Eterm res = NIL;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ goto badarg;
+ }
+ len = binary_size(BIF_ARG_1);
+ ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size);
+ if (bit_size != 0) {
+ goto badarg;
+ }
+ if(do_bin_to_list(BIF_P, bytes, bit_offs, pos, &len, &res) ==
+ BIN_TO_LIST_OK) {
+ BIF_RET(res);
+ }
+ return do_trap_bin_to_list(BIF_P,BIF_ARG_1,pos,len,res);
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+/*
+ * Ok, erlang:list_to_binary does not interrupt, and we really don't want
+ * an alternative implementation for the exact same thing, why we
+ * have descided to use the old non-restarting implementation for now.
+ * In reality, there are seldom many iterations involved in doing this, so the
+ * problem of long-running bifs is not really that big in this case.
+ * So, for now we use the old implementation also in the module binary.
+ */
+
+BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1)
+{
+ return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+}
+
+typedef struct {
+ Uint times_left;
+ Uint source_size;
+ int source_type;
+ byte *source;
+ byte *temp_alloc;
+ Uint result_pos;
+ Binary *result;
+} CopyBinState;
+
+#define BC_TYPE_EMPTY 0
+#define BC_TYPE_HEAP 1
+#define BC_TYPE_ALIGNED 2 /* May or may not point to (emasculated) binary, temp_alloc field is set
+ so that erts_free_aligned_binary_bytes_extra can handle either */
+
+
+#define BINARY_COPY_LOOP_FACTOR 100
+
+static void cleanup_copy_bin_state(Binary *bp)
+{
+ CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(bp);
+ if (cbs->result != NULL) {
+ erts_bin_free(cbs->result);
+ cbs->result = NULL;
+ }
+ switch (cbs->source_type) {
+ case BC_TYPE_HEAP:
+ erts_free(ERTS_ALC_T_BINARY_BUFFER,cbs->source);
+ break;
+ case BC_TYPE_ALIGNED:
+ erts_free_aligned_binary_bytes_extra(cbs->temp_alloc,
+ ERTS_ALC_T_BINARY_BUFFER);
+ break;
+ default:
+ /* otherwise do nothing */
+ break;
+ }
+ cbs->source_type = BC_TYPE_EMPTY;
+}
+
+/*
+ * Binary *erts_bin_nrml_alloc(Uint size);
+ * Binary *erts_bin_realloc(Binary *bp, Uint size);
+ * void erts_bin_free(Binary *bp);
+ */
+static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
+{
+ Uint n;
+ byte *bytes;
+ Uint bit_offs;
+ Uint bit_size;
+ size_t size;
+ Uint reds = get_reds(p, BINARY_COPY_LOOP_FACTOR);
+ Uint target_size;
+ byte *t;
+ Uint pos;
+
+
+ if (is_not_binary(bin)) {
+ goto badarg;
+ }
+ if (!term_to_Uint(en, &n)) {
+ goto badarg;
+ }
+ if (!n) {
+ Eterm res_term = erts_new_heap_binary(p,NULL,0,&bytes);
+ BIF_RET(res_term);
+ }
+ ERTS_GET_BINARY_BYTES(bin,bytes,bit_offs,bit_size);
+ if (bit_size != 0) {
+ goto badarg;
+ }
+
+ size = binary_size(bin);
+ target_size = size * n;
+
+ if ((target_size - size) >= reds) {
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ CopyBinState *cbs;
+ Eterm *hp;
+ Eterm trap_term;
+ int i;
+
+ /* We will trap, set up the structure for trapping right away */
+ Binary *mb = erts_create_magic_binary(sizeof(CopyBinState),
+ cleanup_copy_bin_state);
+ cbs = ERTS_MAGIC_BIN_DATA(mb);
+
+ cbs->temp_alloc = NULL;
+ cbs->source = NULL;
+
+ ERTS_GET_REAL_BIN(bin, orig, offset, bit_offset, bit_size);
+ if (*(binary_val(orig)) == HEADER_PROC_BIN) {
+ ProcBin* pb = (ProcBin *) binary_val(orig);
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+ cbs->source =
+ erts_get_aligned_binary_bytes_extra(bin,
+ &(cbs->temp_alloc),
+ ERTS_ALC_T_BINARY_BUFFER,
+ 0);
+ cbs->source_type = BC_TYPE_ALIGNED;
+ } else { /* Heap binary */
+ cbs->source =
+ erts_get_aligned_binary_bytes_extra(bin,
+ &(cbs->temp_alloc),
+ ERTS_ALC_T_BINARY_BUFFER,
+ 0);
+ if (!(cbs->temp_alloc)) { /* alignment not needed, need to copy */
+ byte *tmp = erts_alloc(ERTS_ALC_T_BINARY_BUFFER,size);
+ memcpy(tmp,cbs->source,size);
+ cbs->source = tmp;
+ cbs->source_type = BC_TYPE_HEAP;
+ } else {
+ cbs->source_type = BC_TYPE_ALIGNED;
+ }
+ }
+ cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap
+ if trapping */
+ cbs->result->flags = 0;
+ cbs->result->orig_size = target_size;
+ erts_refc_init(&(cbs->result->refc), 1);
+ t = (byte *) cbs->result->orig_bytes; /* No offset or anything */
+ pos = 0;
+ i = 0;
+ while (pos < reds) {
+ memcpy(t+pos,cbs->source, size);
+ pos += size;
+ ++i;
+ }
+ cbs->source_size = size;
+ cbs->result_pos = pos;
+ cbs->times_left = n-i;
+ hp = HAlloc(p,PROC_BIN_SIZE);
+ trap_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb);
+ BUMP_ALL_REDS(p);
+ BIF_TRAP2(&binary_copy_trap_export, p, bin, trap_term);
+ } else {
+ Eterm res_term;
+ byte *temp_alloc = NULL;
+ byte *source =
+ erts_get_aligned_binary_bytes(bin,
+ &temp_alloc);
+ if (target_size <= ERL_ONHEAP_BIN_LIMIT) {
+ res_term = erts_new_heap_binary(p,NULL,target_size,&t);
+ } else {
+ res_term = erts_new_mso_binary(p,NULL,target_size);
+ t = ((ProcBin *) binary_val(res_term))->bytes;
+ }
+ pos = 0;
+ while (pos < target_size) {
+ memcpy(t+pos,source, size);
+ pos += size;
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p,pos / BINARY_COPY_LOOP_FACTOR);
+ BIF_RET(res_term);
+ }
+ badarg:
+ BIF_ERROR(p,BADARG);
+}
+
+BIF_RETTYPE binary_copy_trap(BIF_ALIST_2)
+{
+ Uint n;
+ size_t size;
+ Uint reds = get_reds(BIF_P, BINARY_COPY_LOOP_FACTOR);
+ byte *t;
+ Uint pos;
+ Binary *mb = ((ProcBin *) binary_val(BIF_ARG_2))->val;
+ CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(mb);
+ Uint opos;
+
+ /* swapout... */
+ n = cbs->times_left;
+ size = cbs->source_size;
+ opos = pos = cbs->result_pos;
+ t = (byte *) cbs->result->orig_bytes; /* "well behaved" binary */
+ if ((n-1) * size >= reds) {
+ Uint i = 0;
+ while ((pos - opos) < reds) {
+ memcpy(t+pos,cbs->source, size);
+ pos += size;
+ ++i;
+ }
+ cbs->result_pos = pos;
+ cbs->times_left -= i;
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP2(&binary_copy_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2);
+ } else {
+ Binary *save;
+ ProcBin* pb;
+ Uint target_size = cbs->result->orig_size;
+ while (pos < target_size) {
+ memcpy(t+pos,cbs->source, size);
+ pos += size;
+ }
+ save = cbs->result;
+ cbs->result = NULL;
+ cleanup_copy_bin_state(mb); /* now cbs is dead */
+ pb = (ProcBin *) HAlloc(BIF_P, PROC_BIN_SIZE);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = target_size;
+ pb->next = MSO(BIF_P).mso;
+ MSO(BIF_P).mso = pb;
+ pb->val = save;
+ pb->bytes = t;
+ pb->flags = 0;
+
+ MSO(BIF_P).overhead += target_size / sizeof(Eterm);
+ BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR);
+
+ BIF_RET(make_binary(pb));
+ }
+}
+
+
+BIF_RETTYPE binary_copy_1(BIF_ALIST_1)
+{
+ return do_binary_copy(BIF_P,BIF_ARG_1,make_small(1));
+}
+
+BIF_RETTYPE binary_copy_2(BIF_ALIST_2)
+{
+ return do_binary_copy(BIF_P,BIF_ARG_1,BIF_ARG_2);
+}
+
+BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
+{
+ ErlSubBin *sb;
+ ProcBin *pb;
+ Eterm res;
+ Eterm bin = BIF_ARG_1;
+
+ if (is_not_binary(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
+ sb = (ErlSubBin *) binary_val(bin);
+ if (sb->thing_word == HEADER_SUB_BIN) {
+ bin = sb->orig;
+ }
+ pb = (ProcBin *) binary_val(bin);
+ if (pb->thing_word == HEADER_PROC_BIN) {
+ res = erts_make_integer((Uint) pb->val->orig_size, BIF_P); /* XXX:PaN Halfword? orig_size is a long */
+ } else { /* heap binary */
+ res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P);
+ }
+ BIF_RET(res);
+}
+
+#define END_BIG 0
+#define END_SMALL 1
+
+#ifdef WORDS_BIGENDIAN
+#define END_NATIVE END_BIG
+#else
+#define END_NATIVE END_SMALL
+#endif
+
+static int get_need(Uint u) {
+#if defined(ARCH_64) && !HALFWORD_HEAP
+ if (u > 0xFFFFFFFFUL) {
+ if (u > 0xFFFFFFFFFFFFUL) {
+ if (u > 0xFFFFFFFFFFFFFFUL) {
+ return 8;
+ }
+ return 7;
+ }
+ if (u > 0xFFFFFFFFFFUL) {
+ return 6;
+ }
+ return 5;
+ }
+#endif
+ if (u > 0xFFFFUL) {
+ if (u > 0xFFFFFFUL) {
+ return 4;
+ }
+ return 3;
+ }
+ if (u > 0xFFUL) {
+ return 2;
+ }
+ return 1;
+}
+
+static BIF_RETTYPE do_encode_unsigned(Process *p, Eterm uns, Eterm endianess)
+{
+ Eterm res;
+ if ((is_not_small(uns) && is_not_big(uns)) || is_not_atom(endianess) ||
+ (endianess != am_big && endianess != am_little)) {
+ goto badarg;
+ }
+ if (is_small(uns)) {
+ Sint x = signed_val(uns);
+ Uint u;
+ int n,i;
+ byte *b;
+
+ if (x < 0) {
+ goto badarg;
+ }
+
+ u = (Uint) x;
+ n = get_need(u);
+ ASSERT(n <= ERL_ONHEAP_BIN_LIMIT);
+ res = erts_new_heap_binary(p, NULL, n, &b);
+ if (endianess == am_big) {
+ for(i=n-1;i>=0;--i) {
+ b[i] = u & 0xFF;
+ u >>= 8;
+ }
+ } else {
+ for(i=0;i<n;++i) {
+ b[i] = u & 0xFF;
+ u >>= 8;
+ }
+ }
+ BIF_RET(res);
+ } else {
+ /* Big */
+ Eterm *bigp = big_val(uns);
+ Uint n;
+ dsize_t num_parts = BIG_SIZE(bigp);
+ Eterm res;
+ byte *b;
+ ErtsDigit d;
+
+ if(BIG_SIGN(bigp)) {
+ goto badarg;
+ }
+ n = (num_parts-1)*sizeof(ErtsDigit)+get_need(BIG_DIGIT(bigp,(num_parts-1)));
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
+ res = erts_new_heap_binary(p,NULL,n,&b);
+ } else {
+ res = erts_new_mso_binary(p,NULL,n);
+ b = ((ProcBin *) binary_val(res))->bytes;
+ }
+
+ if (endianess == am_big) {
+ Sint i,j;
+ j = 0;
+ d = BIG_DIGIT(bigp,0);
+ for (i=n-1;i>=0;--i) {
+ b[i] = d & 0xFF;
+ if (!((++j) % sizeof(ErtsDigit))) {
+ d = BIG_DIGIT(bigp,j / sizeof(ErtsDigit));
+ } else {
+ d >>= 8;
+ }
+ }
+ } else {
+ Sint i,j;
+ j = 0;
+ d = BIG_DIGIT(bigp,0);
+ for (i=0;i<n;++i) {
+ b[i] = d & 0xFF;
+ if (!((++j) % sizeof(ErtsDigit))) {
+ d = BIG_DIGIT(bigp,j / sizeof(ErtsDigit));
+ } else {
+ d >>= 8;
+ }
+ }
+
+ }
+ BIF_RET(res);
+ }
+ badarg:
+ BIF_ERROR(p,BADARG);
+}
+
+static BIF_RETTYPE do_decode_unsigned(Process *p, Eterm uns, Eterm endianess)
+{
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ Uint size;
+ Eterm res;
+
+ if (is_not_binary(uns) || is_not_atom(endianess) ||
+ (endianess != am_big && endianess != am_little)) {
+ goto badarg;
+ }
+ ERTS_GET_BINARY_BYTES(uns, bytes, bitoffs, bitsize);
+ if (bitsize != 0) {
+ goto badarg;
+ }
+ /* align while rolling */
+ size = binary_size(uns);
+ if (bitoffs) {
+ if (endianess == am_big) {
+ while (size && (((((Uint) bytes[0]) << bitoffs) |
+ (((Uint) bytes[1]) >> (8-bitoffs))) & 0xFF) == 0) {
+ ++bytes;
+ --size;
+ }
+ } else {
+ while(size &&
+ (((((Uint) bytes[size-1]) << bitoffs) |
+ (((Uint) bytes[size]) >> (8-bitoffs))) & 0xFF) == 0) {
+ --size;
+ }
+ }
+ } else {
+ if (endianess == am_big) {
+ while (size && *bytes == 0) {
+ ++bytes;
+ --size;
+ }
+ } else {
+ while(size && bytes[size-1] == 0) {
+ --size;
+ }
+ }
+ }
+ if (!size) {
+ BIF_RET(make_small(0));
+ }
+
+ if (size <= sizeof(Uint)) {
+ Uint u = 0;
+ Sint i;
+
+ if (endianess == am_big) {
+ if (bitoffs) {
+ for(i=0;i<size;++i) {
+ u <<=8;
+ u |= (((((Uint) bytes[i]) << bitoffs) |
+ (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF);
+ }
+ } else {
+ for(i=0;i<size;++i) {
+ u <<=8;
+ u |= bytes[i];
+ }
+ }
+ } else {
+
+ if (bitoffs) {
+ for(i=size-1;i>=0;--i) {
+ u <<=8;
+ u |= (((((Uint) bytes[i]) << bitoffs) |
+ (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF);
+ }
+ } else {
+ for(i=size-1;i>=0;--i) {
+ u <<=8;
+ u |= bytes[i];
+ }
+ }
+ }
+ res = erts_make_integer(u,p);
+ BIF_RET(res);
+ } else {
+ /* Assume big, as we stripped away all zeroes from the MSB part of the binary */
+ dsize_t num_parts = size / sizeof(ErtsDigit) + !!(size % sizeof(ErtsDigit));
+ Eterm *bigp;
+
+ bigp = HAlloc(p, BIG_NEED_SIZE(num_parts));
+ *bigp = make_pos_bignum_header(num_parts);
+ res = make_big(bigp);
+
+ if (endianess == am_big) {
+ Sint i,j;
+ ErtsDigit *d;
+ j = size;
+ d = &(BIG_DIGIT(bigp,num_parts - 1));
+ *d = 0;
+ i = 0;
+ if(bitoffs) {
+ for (;;){
+ (*d) <<= 8;
+ (*d) |= (((((Uint) bytes[i]) << bitoffs) |
+ (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF);
+ if (++i >= size) {
+ break;
+ }
+ if (!(--j % sizeof(ErtsDigit))) {
+ --d;
+ *d = 0;
+ }
+ }
+ } else {
+ for (;;){
+ (*d) <<= 8;
+ (*d) |= bytes[i];
+ if (++i >= size) {
+ break;
+ }
+ if (!(--j % sizeof(ErtsDigit))) {
+ --d;
+ *d = 0;
+ }
+ }
+ }
+ } else {
+ Sint i,j;
+ ErtsDigit *d;
+ j = size;
+ d = &(BIG_DIGIT(bigp,num_parts - 1));
+ *d = 0;
+ i = size-1;
+ if (bitoffs) {
+ for (;;){
+ (*d) <<= 8;
+ (*d) |= (((((Uint) bytes[i]) << bitoffs) |
+ (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF);
+ if (--i < 0) {
+ break;
+ }
+ if (!(--j % sizeof(ErtsDigit))) {
+ --d;
+ *d = 0;
+ }
+ }
+ } else {
+ for (;;){
+ (*d) <<= 8;
+ (*d) |= bytes[i];
+ if (--i < 0) {
+ break;
+ }
+ if (!(--j % sizeof(ErtsDigit))) {
+ --d;
+ *d = 0;
+ }
+ }
+ }
+ }
+ BIF_RET(res);
+ }
+ badarg:
+ BIF_ERROR(p,BADARG);
+}
+
+BIF_RETTYPE binary_encode_unsigned_1(BIF_ALIST_1)
+{
+ return do_encode_unsigned(BIF_P,BIF_ARG_1,am_big);
+}
+
+BIF_RETTYPE binary_encode_unsigned_2(BIF_ALIST_2)
+{
+ return do_encode_unsigned(BIF_P,BIF_ARG_1,BIF_ARG_2);
+}
+
+BIF_RETTYPE binary_decode_unsigned_1(BIF_ALIST_1)
+{
+ return do_decode_unsigned(BIF_P,BIF_ARG_1,am_big);
+}
+
+BIF_RETTYPE binary_decode_unsigned_2(BIF_ALIST_2)
+{
+ return do_decode_unsigned(BIF_P,BIF_ARG_1,BIF_ARG_2);
+}
+
+/*
+ * Hard debug functions (dump) for the search structures
+ */
+
+#ifdef HARDDEBUG
+static void dump_bm_data(BMData *bm)
+{
+ int i,j;
+ erts_printf("Dumping Boyer-Moore structure.\n");
+ erts_printf("=============================\n");
+ erts_printf("Searchstring [%ld]:\n", bm->len);
+ erts_printf("<<");
+ for (i = 0; i < bm->len; ++i) {
+ if (i > 0) {
+ erts_printf(", ");
+ }
+ erts_printf("%d", (int) bm->x[i]);
+ if (bm->x[i] >= 'A') {
+ erts_printf(" ($%c)",(char) bm->x[i]);
+ }
+ }
+ erts_printf(">>\n");
+ erts_printf("GoodShift array:\n");
+ for (i = 0; i < bm->len; ++i) {
+ erts_printf("GoodShift[%d]: %ld\n", i, bm->goodshift[i]);
+ }
+ erts_printf("BadShift array:\n");
+ j = 0;
+ for (i = 0; i < ALPHABET_SIZE; i += j) {
+ for (j = 0; i + j < ALPHABET_SIZE && j < 6; ++j) {
+ erts_printf("BS[%03d]:%02ld, ", i+j, bm->badshift[i+j]);
+ }
+ erts_printf("\n");
+ }
+}
+
+static void dump_ac_node(ACNode *node, int indent, int ch) {
+ int i;
+ char *spaces = erts_alloc(ERTS_ALC_T_TMP, 10 * indent + 1);
+ memset(spaces,' ',10*indent);
+ spaces[10*indent] = '\0';
+ erts_printf("%s-> %c\n",spaces,ch);
+ erts_printf("%sId: %u\n",spaces,(unsigned) node->id);
+ erts_printf("%sD: %u\n",spaces,(unsigned)node->d);
+ erts_printf("%sFinal: %d\n",spaces,(int)node->final);
+ erts_printf("%sFail: %u\n",spaces,(unsigned)node->h->id);
+ erts_free(ERTS_ALC_T_TMP,spaces);
+ for(i=0;i<ALPHABET_SIZE;++i) {
+ if (node->g[i] != NULL && node->g[i] != node) {
+ dump_ac_node(node->g[i],indent+1,i);
+ }
+ }
+}
+
+
+static void dump_ac_trie(ACTrie *act)
+{
+ erts_printf("Aho Corasick Trie dump.\n");
+ erts_printf("=======================\n");
+ erts_printf("Node counter: %u\n", (unsigned) act->idc);
+ erts_printf("Searchstring counter: %u\n", (unsigned) act->counter);
+ erts_printf("Trie:\n");
+ dump_ac_node(act->root, 0, '0');
+ return;
+}
+#endif
diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c
index 440b0b4f14..01e6977a2c 100644
--- a/erts/emulator/beam/erl_bif_guard.c
+++ b/erts/emulator/beam/erl_bif_guard.c
@@ -314,6 +314,30 @@ double_to_integer(Process* p, double x)
return res;
}
+/********************************************************************************
+ * binary_part guards. The actual implementation is in erl_bif_binary.c
+ ********************************************************************************/
+BIF_RETTYPE binary_part_3(BIF_ALIST_3)
+{
+ return erts_binary_part(BIF_P,BIF_ARG_1,BIF_ARG_2, BIF_ARG_3);
+}
+
+BIF_RETTYPE binary_part_2(BIF_ALIST_2)
+{
+ Eterm *tp;
+ if (is_not_tuple(BIF_ARG_2)) {
+ goto badarg;
+ }
+ tp = tuple_val(BIF_ARG_2);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ return erts_binary_part(BIF_P,BIF_ARG_1,tp[1], tp[2]);
+ badarg:
+ BIF_ERROR(BIF_P,BADARG);
+}
+
+
/*
* The following code is used when a guard that may build on the
* heap is called directly. They must not use HAlloc(), but must
@@ -630,3 +654,16 @@ gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live)
}
return res;
}
+
+/********************************************************************************
+ * binary_part guards. The actual implementation is in erl_bif_binary.c
+ ********************************************************************************/
+Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live)
+{
+ return erts_gc_binary_part(p,reg,live,0);
+}
+
+Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live)
+{
+ return erts_gc_binary_part(p,reg,live,1);
+}
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 18cb09d8cd..70d0e91a2c 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -1140,9 +1140,9 @@ process_info_aux(Process *BIF_P,
}
else {
/* Make our copy of the message */
- ASSERT(size_object(msg) == hfp->size);
+ ASSERT(size_object(msg) == hfp->used_size);
msg = copy_struct(msg,
- hfp->size,
+ hfp->used_size,
&hp,
&MSO(BIF_P));
}
@@ -2715,7 +2715,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_links(prt->nlinks, &one_link_size, &size);
for (bp = prt->bp; bp; bp = bp->next)
- size += sizeof(ErlHeapFragment) + (bp->size - 1)*sizeof(Eterm);
+ size += sizeof(ErlHeapFragment) + (bp->alloc_size - 1)*sizeof(Eterm);
if (prt->linebuf)
size += sizeof(LineBuf) + prt->linebuf->ovsiz;
@@ -3567,6 +3567,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
}
}
}
+ else if (ERTS_IS_ATOM_STR("binary_loop_limit", BIF_ARG_1)) {
+ /* Used by binary_module_SUITE (stdlib) */
+ Uint max_loops;
+ if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) {
+ max_loops = erts_binary_set_loop_limit(-1);
+ BIF_RET(make_small(max_loops));
+ } else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) {
+ max_loops = erts_binary_set_loop_limit(max_loops);
+ BIF_RET(make_small(max_loops));
+ }
+ }
else if (ERTS_IS_ATOM_STR("re_loop_limit", BIF_ARG_1)) {
/* Used by re_SUITE (stdlib) */
Uint max_loops;
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index 9b56ddd4f8..378c5e73fd 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -579,8 +579,8 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1)
if (prt->bp == NULL) { /* MUST be CONST! */
res = prt->data;
} else {
- Eterm* hp = HAlloc(BIF_P, prt->bp->size);
- res = copy_struct(prt->data, prt->bp->size, &hp, &MSO(BIF_P));
+ Eterm* hp = HAlloc(BIF_P, prt->bp->used_size);
+ res = copy_struct(prt->data, prt->bp->used_size, &hp, &MSO(BIF_P));
}
erts_smp_port_unlock(prt);
BIF_RET(res);
diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c
index eb40c75110..4ae2f6ebf4 100644
--- a/erts/emulator/beam/erl_bif_timer.c
+++ b/erts/emulator/beam/erl_bif_timer.c
@@ -357,7 +357,7 @@ bif_timer_timeout(ErtsBifTimer* btm)
rp,
&rp_locks);
} else {
- Eterm old_size = bp->size;
+ Eterm old_size = bp->used_size;
bp = erts_resize_message_buffer(bp, old_size + wrap_size,
&message, 1);
hp = &bp->mem[0] + old_size;
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 5b0b3bcec2..a569fe2e85 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -21,6 +21,7 @@
#define __ERL_BINARY_H
#include "erl_threads.h"
+#include "bif.h"
/*
* Maximum number of bytes to place in a heap binary.
@@ -150,7 +151,16 @@ do { \
void erts_init_binary(void);
-byte* erts_get_aligned_binary_bytes_extra(Eterm, byte**, unsigned extra);
+byte* erts_get_aligned_binary_bytes_extra(Eterm, byte**, ErtsAlcType_t, unsigned extra);
+
+/*
+ * Common implementation for erlang:list_to_binary/1 and binary:list_to_bin/1
+ */
+
+BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg);
+BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple);
+BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen);
+
#if defined(__i386__) || !defined(__GNUC__)
/*
@@ -168,6 +178,7 @@ byte* erts_get_aligned_binary_bytes_extra(Eterm, byte**, unsigned extra);
ERTS_GLB_INLINE byte* erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr);
ERTS_GLB_INLINE void erts_free_aligned_binary_bytes(byte* buf);
+ERTS_GLB_INLINE void erts_free_aligned_binary_bytes_extra(byte* buf, ErtsAlcType_t);
ERTS_GLB_INLINE Binary *erts_bin_drv_alloc_fnf(Uint size);
ERTS_GLB_INLINE Binary *erts_bin_drv_alloc(Uint size);
ERTS_GLB_INLINE Binary *erts_bin_nrml_alloc(Uint size);
@@ -184,17 +195,23 @@ ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size,
ERTS_GLB_INLINE byte*
erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr)
{
- return erts_get_aligned_binary_bytes_extra(bin, base_ptr, 0);
+ return erts_get_aligned_binary_bytes_extra(bin, base_ptr, ERTS_ALC_T_TMP, 0);
}
ERTS_GLB_INLINE void
-erts_free_aligned_binary_bytes(byte* buf)
+erts_free_aligned_binary_bytes_extra(byte* buf, ErtsAlcType_t allocator)
{
if (buf) {
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ erts_free(allocator, (void *) buf);
}
}
+ERTS_GLB_INLINE void
+erts_free_aligned_binary_bytes(byte* buf)
+{
+ erts_free_aligned_binary_bytes_extra(buf,ERTS_ALC_T_TMP);
+}
+
/* Explicit extra bytes allocated to counter buggy drivers.
** These extra bytes where earlier (< R13B04) added by an alignment-bug
** in this code. Do we dare remove this in some major release (R14?) maybe?
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index fd7de98ac9..93a47eb76f 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -1547,10 +1547,9 @@ restart:
*/
context.save = NULL;
error: /* Here is were we land when compilation failed. */
- while (context.save != NULL) {
- ErlHeapFragment *ll = context.save->next;
+ if (context.save != NULL) {
free_message_buffer(context.save);
- context.save = ll;
+ context.save = NULL;
}
DMC_FREE(stack);
DMC_FREE(text);
@@ -1567,15 +1566,11 @@ error: /* Here is were we land when compilation failed. */
void erts_db_match_prog_destructor(Binary *bprog)
{
MatchProg *prog;
- ErlHeapFragment *tmp, *ll;
if (bprog == NULL)
return;
prog = Binary2MatchProg(bprog);
- tmp = prog->term_save;
- while (tmp != NULL) {
- ll = tmp->next;
- free_message_buffer(tmp);
- tmp = ll;
+ if (prog->term_save != NULL) {
+ free_message_buffer(prog->term_save);
}
if (prog->saved_program_buf != NULL)
free_message_buffer(prog->saved_program_buf);
@@ -4125,7 +4120,7 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info)
DMC_INIT_STACK(heap);
p = expr->mem;
- i = expr->size;
+ i = expr->used_size;
while (i--) {
if (is_thing(*p)) {
a = thing_arityval(*p);
@@ -4154,7 +4149,7 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info)
}
p = expr->mem;
- i = expr->size;
+ i = expr->used_size;
while (i--) {
if (is_thing(*p)) {
a = thing_arityval(*p);
diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c
index 58d3f92f56..d7d6fcf0a2 100644
--- a/erts/emulator/beam/erl_debug.c
+++ b/erts/emulator/beam/erl_debug.c
@@ -261,7 +261,7 @@ static int verify_eterm(Process *p,Eterm element)
return 1;
for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) {
- if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->size)) {
+ if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->used_size)) {
return 1;
}
}
@@ -308,7 +308,7 @@ void erts_check_stack(Process *p)
if (IN_HEAP(p, ptr))
continue;
for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next)
- if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->size)) {
+ if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->used_size)) {
in_mbuf = 1;
break;
}
@@ -746,7 +746,7 @@ static void print_process_memory(Process *p)
PTR_SIZE, "heap fragments",
dashes, dashes, dashes, dashes);
while (bp) {
- print_untagged_memory(bp->mem,bp->mem + bp->size);
+ print_untagged_memory(bp->mem,bp->mem + bp->used_size);
bp = bp->next;
}
}
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 9ed566e66e..a19e090f1e 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -667,7 +667,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
case TAG_PRIMARY_BOXED:
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
} else if (in_area(ptr, area, area_size)) {
@@ -679,7 +679,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
case TAG_PRIMARY_LIST:
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) { /* Moved */
+ if (IS_MOVED_CONS(val)) { /* Moved */
*g_ptr++ = ptr[1];
} else if (in_area(ptr, area, area_size)) {
MOVE_CONS(ptr,val,old_htop,g_ptr++);
@@ -913,7 +913,7 @@ do_minor(Process *p, int new_sz, Eterm* objv, int nobj)
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
} else if (in_area(ptr, heap, mature_size)) {
@@ -929,7 +929,7 @@ do_minor(Process *p, int new_sz, Eterm* objv, int nobj)
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) { /* Moved */
+ if (IS_MOVED_CONS(val)) { /* Moved */
*g_ptr++ = ptr[1];
} else if (in_area(ptr, heap, mature_size)) {
MOVE_CONS(ptr,val,old_htop,g_ptr++);
@@ -972,7 +972,7 @@ do_minor(Process *p, int new_sz, Eterm* objv, int nobj)
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
} else if (in_area(ptr, heap, mature_size)) {
@@ -987,7 +987,7 @@ do_minor(Process *p, int new_sz, Eterm* objv, int nobj)
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
} else if (in_area(ptr, heap, mature_size)) {
MOVE_CONS(ptr,val,old_htop,n_hp++);
@@ -1008,7 +1008,7 @@ do_minor(Process *p, int new_sz, Eterm* objv, int nobj)
Eterm* origptr = &(mb->orig);
ptr = boxed_val(*origptr);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(val);
} else if (in_area(ptr, heap, mature_size)) {
@@ -1161,7 +1161,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
@@ -1175,7 +1175,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*g_ptr++ = ptr[1];
} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
MOVE_CONS(ptr,val,n_htop,g_ptr++);
@@ -1216,7 +1216,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
@@ -1229,7 +1229,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
} else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
MOVE_CONS(ptr,val,n_htop,n_hp++);
@@ -1249,7 +1249,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
origptr = &(mb->orig);
ptr = boxed_val(*origptr);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(*origptr);
} else if (in_area(ptr, src, src_size) ||
@@ -1392,17 +1392,12 @@ combined_message_size(Process* p)
static void
remove_message_buffers(Process* p)
{
- ErlHeapFragment* bp = MBUF(p);
-
- MBUF(p) = NULL;
- MBUF_SIZE(p) = 0;
- while (bp != NULL) {
- ErlHeapFragment* next_bp = bp->next;
- free_message_buffer(bp);
- bp = next_bp;
- }
+ if (MBUF(p) != NULL) {
+ free_message_buffer(MBUF(p));
+ MBUF(p) = NULL;
+ }
+ MBUF_SIZE(p) = 0;
}
-
#ifdef HARDDEBUG
/*
@@ -1433,12 +1428,12 @@ disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
case TAG_PRIMARY_BOXED: {
ptr = _unchecked_boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
objv++;
} else {
for (qb = mbuf; qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
+ if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1450,11 +1445,11 @@ disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
case TAG_PRIMARY_LIST: {
ptr = _unchecked_list_val(gval);
val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
objv++;
} else {
for (qb = mbuf; qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
+ if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1499,7 +1494,7 @@ disallow_heap_frag_ref_in_heap(Process* p)
ptr = _unchecked_boxed_val(val);
if (!in_area(ptr, heap, heap_size)) {
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
+ if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1509,7 +1504,7 @@ disallow_heap_frag_ref_in_heap(Process* p)
ptr = _unchecked_list_val(val);
if (!in_area(ptr, heap, heap_size)) {
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
+ if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1557,7 +1552,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
abort();
}
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
+ if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1570,7 +1565,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
abort();
}
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) {
+ if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1610,7 +1605,7 @@ sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size)
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
} else if (in_area(ptr, src, src_size)) {
@@ -1623,7 +1618,7 @@ sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size)
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) { /* Moved */
+ if (IS_MOVED_CONS(val)) {
*g_ptr++ = ptr[1];
} else if (in_area(ptr, src, src_size)) {
MOVE_CONS(ptr,val,htop,g_ptr++);
@@ -1657,7 +1652,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
} else if (in_area(ptr, src, src_size)) {
@@ -1670,7 +1665,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
} else if (in_area(ptr, src, src_size)) {
MOVE_CONS(ptr,val,n_htop,n_hp++);
@@ -1690,7 +1685,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
origptr = &(mb->orig);
ptr = boxed_val(*origptr);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(*origptr);
} else if (in_area(ptr, src, src_size)) {
@@ -1722,7 +1717,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
case TAG_PRIMARY_BOXED: {
ptr = boxed_val(gval);
val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*heap_ptr++ = val;
} else if (in_area(ptr, src, src_size)) {
@@ -1735,7 +1730,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
case TAG_PRIMARY_LIST: {
ptr = list_val(gval);
val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*heap_ptr++ = ptr[1];
} else if (in_area(ptr, src, src_size)) {
MOVE_CONS(ptr,val,htop,heap_ptr++);
@@ -1830,28 +1825,6 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
return n_htop;
}
-#ifdef DEBUG
-static Eterm follow_moved(Eterm term)
-{
- Eterm* ptr;
- switch (primary_tag(term)) {
- case TAG_PRIMARY_IMMED1:
- break;
- case TAG_PRIMARY_BOXED:
- ptr = boxed_val(term);
- if (IS_MOVED(*ptr)) term = *ptr;
- break;
- case TAG_PRIMARY_LIST:
- ptr = list_val(term);
- if (is_non_value(ptr[0])) term = ptr[1];
- break;
- default:
- abort();
- }
- return term;
-}
-#endif
-
static Uint
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
@@ -2090,7 +2063,7 @@ sweep_proc_externals(Process *p, int fullsweep)
while (ptr) {
Eterm* ppt = (Eterm *) ptr;
- if (IS_MOVED(*ppt)) { /* Object is alive */
+ if (IS_MOVED_BOXED(*ppt)) { /* Object is alive */
ExternalThing* ro = external_thing_ptr(*ppt);
*prev = ro; /* Patch to moved pos */
@@ -2130,7 +2103,7 @@ sweep_proc_funs(Process *p, int fullsweep)
while (ptr) {
Eterm* ppt = (Eterm *) ptr;
- if (IS_MOVED(*ppt)) { /* Object is alive */
+ if (IS_MOVED_BOXED(*ppt)) { /* Object is alive */
ErlFunThing* ro = (ErlFunThing *) fun_val(*ppt);
*prev = ro; /* Patch to moved pos */
@@ -2244,7 +2217,7 @@ sweep_proc_bins(Process *p, int fullsweep)
while (ptr) {
Eterm* ppt = (Eterm *) ptr;
- if (IS_MOVED(*ppt)) { /* Object is alive */
+ if (IS_MOVED_BOXED(*ppt)) { /* Object is alive */
bin_vheap += ptr->size / sizeof(Eterm);
ptr = (ProcBin*) binary_val(*ppt);
link_live_proc_bin(&shrink,
@@ -2542,7 +2515,7 @@ within2(Eterm *ptr, Process *p, Eterm *real_htop)
return 1;
}
while (bp != NULL) {
- if (bp->mem <= ptr && ptr < bp->mem + bp->size) {
+ if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) {
return 1;
}
bp = bp->next;
@@ -2556,7 +2529,7 @@ within2(Eterm *ptr, Process *p, Eterm *real_htop)
hfp = erts_dist_ext_trailer(mp->data.dist_ext);
else
hfp = NULL;
- if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->size)
+ if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->used_size)
return 1;
}
mp = mp->next;
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index af55b6363f..807ef8ae8d 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 2007-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 2007-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
* 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%
*/
@@ -22,11 +22,12 @@
/* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */
-#ifdef DEBUG
+#if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF
# define HARDDEBUG 1
#endif
-#define IS_MOVED(x) (!is_header((x)))
+#define IS_MOVED_BOXED(x) (!is_header((x)))
+#define IS_MOVED_CONS(x) (is_non_value((x)))
#define MOVE_CONS(PTR,CAR,HTOP,ORIG) \
do { \
@@ -69,4 +70,28 @@ extern Uint erts_test_long_gc_sleep;
int within(Eterm *ptr, Process *p);
#endif
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
+{
+ Eterm* ptr;
+ switch (primary_tag(term)) {
+ case TAG_PRIMARY_IMMED1:
+ break;
+ case TAG_PRIMARY_BOXED:
+ ptr = boxed_val(term);
+ if (IS_MOVED_BOXED(*ptr)) term = *ptr;
+ break;
+ case TAG_PRIMARY_LIST:
+ ptr = list_val(term);
+ if (IS_MOVED_CONS(ptr[0])) term = ptr[1];
+ break;
+ default:
+ ASSERT(!"strange tag in follow_moved");
+ }
+ return term;
+}
+#endif
+
#endif /* __ERL_GC_H__ */
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index e63ec8a3cc..2ee802cf3e 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -281,6 +281,7 @@ erl_init(void)
init_load();
erts_init_bif();
erts_init_bif_chksum();
+ erts_init_bif_binary();
erts_init_bif_re();
erts_init_unicode(); /* after RE to get access to PCRE unicode */
erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2);
@@ -335,59 +336,6 @@ init_shared_memory(int argc, char **argv)
#endif
}
-
-/*
- * Create the very first process.
- */
-
-void
-erts_first_process(Eterm modname, void* code, unsigned size, int argc, char** argv)
-{
- int i;
- Eterm args;
- Eterm pid;
- Eterm* hp;
- Process parent;
- Process* p;
- ErlSpawnOpts so;
-
- if (erts_find_function(modname, am_start, 1) == NULL) {
- char sbuf[256];
- Atom* ap;
-
- ap = atom_tab(atom_val(modname));
- memcpy(sbuf, ap->name, ap->len);
- sbuf[ap->len] = '\0';
- erl_exit(5, "No function %s:start/1\n", sbuf);
- }
-
- /*
- * We need a dummy parent process to be able to call erl_create_process().
- */
- erts_init_empty_process(&parent);
- hp = HAlloc(&parent, argc*2 + 4);
- args = NIL;
- for (i = argc-1; i >= 0; i--) {
- int len = sys_strlen(argv[i]);
- args = CONS(hp, new_binary(&parent, (byte*)argv[i], len), args);
- hp += 2;
- }
- args = CONS(hp, new_binary(&parent, code, size), args);
- hp += 2;
- args = CONS(hp, args, NIL);
-
- so.flags = 0;
- pid = erl_create_process(&parent, modname, am_start, args, &so);
- p = process_tab[internal_pid_index(pid)];
- p->group_leader = pid;
-
- erts_cleanup_empty_process(&parent);
-}
-
-/*
- * XXX Old way of starting. Hopefully soon obsolete.
- */
-
static void
erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** argv)
{
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index a056fce0c5..b63f3df7df 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -42,6 +42,15 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message,
#undef HARD_DEBUG
#endif
+
+
+
+static ERTS_INLINE int in_heapfrag(const Eterm* ptr, const ErlHeapFragment *bp)
+{
+ return ((unsigned)(ptr - bp->mem) < bp->used_size);
+}
+
+
void
init_message(void)
{
@@ -81,9 +90,12 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
#endif
ErlHeapFragment* nbp;
+ /* ToDo: Make use of 'used_size' to avoid realloc
+ when shrinking just a few words */
+
#ifdef DEBUG
{
- Uint off_sz = size < bp->size ? size : bp->size;
+ Uint off_sz = size < bp->used_size ? size : bp->used_size;
for (i = 0; i < brefs_size; i++) {
Eterm *ptr;
if (is_immed(brefs[i]))
@@ -95,12 +107,12 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
}
#endif
- if (size == bp->size)
+ if (size == bp->used_size)
return bp;
#ifdef HARD_DEBUG
dbg_brefs = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(Eterm *)*brefs_size);
- dbg_bp = new_message_buffer(bp->size);
+ dbg_bp = new_message_buffer(bp->used_size);
dbg_hp = dbg_bp->mem;
dbg_tot_size = 0;
for (i = 0; i < brefs_size; i++) {
@@ -109,15 +121,15 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
dbg_brefs[i] = copy_struct(brefs[i], dbg_size, &dbg_hp,
&dbg_bp->off_heap);
}
- ASSERT(dbg_tot_size == (size < bp->size ? size : bp->size));
+ ASSERT(dbg_tot_size == (size < bp->used_size ? size : bp->used_size));
#endif
nbp = (ErlHeapFragment*) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP_FRAG,
(void *) bp,
- ERTS_HEAP_FRAG_SIZE(bp->size),
+ ERTS_HEAP_FRAG_SIZE(bp->alloc_size),
ERTS_HEAP_FRAG_SIZE(size));
if (bp != nbp) {
- Uint off_sz = size < nbp->size ? size : nbp->size;
+ Uint off_sz = size < nbp->used_size ? size : nbp->used_size;
Eterm *sp = &bp->mem[0];
Eterm *ep = sp + off_sz;
Sint offs = &nbp->mem[0] - sp;
@@ -135,7 +147,7 @@ erts_resize_message_buffer(ErlHeapFragment *bp, Uint size,
}
#endif
}
- nbp->size = size;
+ nbp->alloc_size = size;
nbp->used_size = size;
#ifdef HARD_DEBUG
@@ -168,10 +180,15 @@ erts_cleanup_offheap(ErlOffHeap *offheap)
void
free_message_buffer(ErlHeapFragment* bp)
{
- erts_cleanup_offheap(&bp->off_heap);
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG,
- (void *) bp,
- ERTS_HEAP_FRAG_SIZE(bp->size));
+ ASSERT(bp != NULL);
+ do {
+ ErlHeapFragment* next_bp = bp->next;
+
+ erts_cleanup_offheap(&bp->off_heap);
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, (void *) bp,
+ ERTS_HEAP_FRAG_SIZE(bp->size));
+ bp = next_bp;
+ }while (bp != NULL);
}
static ERTS_INLINE void
@@ -181,7 +198,7 @@ link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp)
/* Link the message buffer */
bp->next = MBUF(proc);
MBUF(proc) = bp;
- MBUF_SIZE(proc) += bp->size;
+ MBUF_SIZE(proc) += bp->used_size;
FLAGS(proc) |= F_FORCE_GC;
/* Move any binaries into the process */
@@ -242,7 +259,7 @@ erts_msg_distext2heap(Process *pp,
goto decode_error;
if (is_not_nil(*tokenp)) {
ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- tok_sz = heap_frag->size;
+ tok_sz = heap_frag->used_size;
sz += tok_sz;
}
if (pp)
@@ -283,12 +300,13 @@ erts_msg_distext2heap(Process *pp,
erts_cleanup_offheap(&heap_frag->off_heap);
}
erts_free_dist_ext_copy(dist_extp);
- if (*bpp)
+ if (*bpp) {
free_message_buffer(*bpp);
+ *bpp = NULL;
+ }
else if (hp) {
HRelease(pp, hp_end, hp);
}
- *bpp = NULL;
return THE_NON_VALUE;
}
@@ -436,11 +454,10 @@ erts_queue_message(Process* receiver,
ERL_MESSAGE_TERM(mp) = message;
ERL_MESSAGE_TOKEN(mp) = seq_trace_token;
mp->next = NULL;
+ mp->data.heap_frag = bp;
#ifdef ERTS_SMP
if (*receiver_locks & ERTS_PROC_LOCK_MAIN) {
- mp->data.heap_frag = bp;
-
/*
* We move 'in queue' to 'private queue' and place
* message at the end of 'private queue' in order
@@ -453,11 +470,9 @@ erts_queue_message(Process* receiver,
LINK_MESSAGE_PRIVQ(receiver, mp);
}
else {
- mp->data.heap_frag = bp;
LINK_MESSAGE(receiver, mp);
}
#else
- mp->data.heap_frag = bp;
LINK_MESSAGE(receiver, mp);
#endif
@@ -530,32 +545,27 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
#ifdef HARD_DEBUG
dbg_term_sz = size_object(term);
dbg_token_sz = size_object(token);
- ASSERT(bp->size == dbg_term_sz + dbg_token_sz);
-
- dbg_bp = new_message_buffer(bp->size);
+ /*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg));
+ Copied size may be smaller due to removed SubBins's or garbage.
+ Copied size may be larger due to duplicated shared terms.
+ */
+ dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz);
dbg_hp = dbg_bp->mem;
dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap);
dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap);
dbg_thp_start = *hpp;
#endif
- ASSERT(bp);
- msg->data.attached = NULL;
+ if (bp->next != NULL) {
+ move_multi_frags(hpp, off_heap, bp, msg->m, 2);
+ goto copy_done;
+ }
off_heap->overhead += bp->off_heap.overhead;
- sz = bp->size;
+ sz = bp->used_size;
-#ifdef DEBUG
- if (is_not_immed(term)) {
- ASSERT(bp->mem <= ptr_val(term));
- ASSERT(bp->mem + bp->size > ptr_val(term));
- }
-
- if (is_not_immed(token)) {
- ASSERT(bp->mem <= ptr_val(token));
- ASSERT(bp->mem + bp->size > ptr_val(token));
- }
-#endif
+ ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp));
+ ASSERT(is_immed(token) || in_heapfrag(ptr_val(token),bp));
fhp = bp->mem;
hp = *hpp;
@@ -574,8 +584,7 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
break;
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
- ASSERT(bp->mem <= ptr_val(val));
- ASSERT(bp->mem + bp->size > ptr_val(val));
+ ASSERT(in_heapfrag(ptr_val(val), bp));
*hp++ = offset_ptr(val, offs);
break;
case TAG_PRIMARY_HEADER:
@@ -609,6 +618,7 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
cpy_sz = header_arity(val);
cpy_words:
+ ASSERT(sz >= cpy_sz);
sz -= cpy_sz;
while (cpy_sz >= 8) {
cpy_sz -= 8;
@@ -676,12 +686,11 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
}
}
- ASSERT(bp->size == hp - *hpp);
+ ASSERT(bp->used_size == hp - *hpp);
*hpp = hp;
if (is_not_immed(token)) {
- ASSERT(bp->mem <= ptr_val(token));
- ASSERT(bp->mem + bp->size > ptr_val(token));
+ ASSERT(in_heapfrag(ptr_val(token), bp));
ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg)));
@@ -690,8 +699,7 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
}
if (is_not_immed(term)) {
- ASSERT(bp->mem <= ptr_val(term));
- ASSERT(bp->mem + bp->size > ptr_val(term));
+ ASSERT(in_heapfrag(ptr_val(term),bp));
ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg)));
@@ -699,10 +707,12 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
#endif
}
+copy_done:
#ifdef HARD_DEBUG
{
int i, j;
+ ErlHeapFragment* frag;
{
ProcBin *mso = off_heap->mso;
i = j = 0;
@@ -710,10 +720,12 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
mso = mso->next;
i++;
}
- mso = bp->off_heap.mso;
- while (mso) {
- mso = mso->next;
- j++;
+ for (frag=bp; frag; frag=frag->next) {
+ mso = frag->off_heap.mso;
+ while (mso) {
+ mso = mso->next;
+ j++;
+ }
}
ASSERT(i == j);
}
@@ -724,10 +736,12 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
fun = fun->next;
i++;
}
- fun = bp->off_heap.funs;
- while (fun) {
- fun = fun->next;
- j++;
+ for (frag=bp; frag; frag=frag->next) {
+ fun = frag->off_heap.funs;
+ while (fun) {
+ fun = fun->next;
+ j++;
+ }
}
ASSERT(i == j);
}
@@ -738,10 +752,12 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
external = external->next;
i++;
}
- external = bp->off_heap.externals;
- while (external) {
- external = external->next;
- j++;
+ for (frag=bp; frag; frag=frag->next) {
+ external = frag->off_heap.externals;
+ while (external) {
+ external = external->next;
+ j++;
+ }
}
ASSERT(i == j);
}
@@ -755,6 +771,7 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
#endif
bp->off_heap.externals = NULL;
free_message_buffer(bp);
+ msg->data.heap_frag = NULL;
#ifdef HARD_DEBUG
ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term));
@@ -764,6 +781,7 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
}
+
Uint
erts_msg_attached_data_size_aux(ErlMessage *msg)
{
@@ -789,7 +807,7 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
if (is_not_nil(msg->m[1])) {
ErlHeapFragment *heap_frag;
heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- sz += heap_frag->size;
+ sz += heap_frag->used_size;
}
return sz;
}
@@ -805,7 +823,7 @@ erts_move_msg_attached_data_to_heap(Eterm **hpp, ErlOffHeap *ohp, ErlMessage *ms
ErlHeapFragment *heap_frag;
heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
ERL_MESSAGE_TOKEN(msg) = copy_struct(ERL_MESSAGE_TOKEN(msg),
- heap_frag->size,
+ heap_frag->used_size,
hpp,
ohp);
erts_cleanup_offheap(&heap_frag->off_heap);
@@ -1062,3 +1080,4 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp,
erts_queue_message(to, to_locksp, bp, save, NIL);
}
}
+
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 459c6363aa..f478572ac2 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -49,7 +49,7 @@ typedef struct erl_heap_fragment ErlHeapFragment;
struct erl_heap_fragment {
ErlHeapFragment* next; /* Next heap fragment */
ErlOffHeap off_heap; /* Offset heap data. */
- unsigned size; /* Size in (half)words of mem */
+ unsigned alloc_size; /* Size in (half)words of mem */
unsigned used_size; /* With terms to be moved to heap by GC */
Eterm mem[1]; /* Data */
};
@@ -75,6 +75,13 @@ typedef struct {
ErlMessage** last; /* point to the last next pointer */
ErlMessage** save;
int len; /* queue length */
+
+ /*
+ * The following two fields are used by the recv_mark/1 and
+ * recv_set/1 instructions.
+ */
+ BeamInstr* mark; /* address to rec_loop/2 instruction */
+ ErlMessage** saved_last; /* saved last pointer */
} ErlMessageQueue;
#ifdef ERTS_SMP
@@ -137,6 +144,7 @@ do { \
(p)->msg.len--; \
if (__mp == NULL) \
(p)->msg.last = (p)->msg.save; \
+ (p)->msg.mark = 0; \
} while(0)
/* Reset message save point (after receive match) */
@@ -191,7 +199,7 @@ do { \
#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \
do { \
(HEAP_FRAG_P)->next = NULL; \
- (HEAP_FRAG_P)->size = (DATA_WORDS); \
+ (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \
(HEAP_FRAG_P)->used_size = (DATA_WORDS); \
(HEAP_FRAG_P)->off_heap.mso = NULL; \
(HEAP_FRAG_P)->off_heap.funs = NULL; \
@@ -219,14 +227,25 @@ void erts_move_msg_attached_data_to_heap(Eterm **, ErlOffHeap *, ErlMessage *);
Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **,
Eterm *, ErtsDistExternal *);
+ERTS_GLB_INLINE Uint erts_msg_used_frag_sz(const ErlMessage *msg);
ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Uint erts_msg_used_frag_sz(const ErlMessage *msg)
+{
+ const ErlHeapFragment *bp;
+ Uint sz = 0;
+ for (bp = msg->data.heap_frag; bp!=NULL; bp=bp->next) {
+ sz += bp->used_size;
+ }
+ return sz;
+}
+
ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg)
{
ASSERT(msg->data.attached);
if (is_value(ERL_MESSAGE_TERM(msg)))
- return msg->data.heap_frag->size;
+ return erts_msg_used_frag_sz(msg);
else if (msg->data.dist_ext->heap_size < 0)
return erts_msg_attached_data_size_aux(msg);
else {
@@ -234,7 +253,7 @@ ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg)
if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
ErlHeapFragment *heap_frag;
heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- sz += heap_frag->size;
+ sz += heap_frag->used_size;
}
return sz;
}
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 2790020117..75de00d4c1 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -48,7 +48,7 @@ struct erl_module_nif {
struct enif_entry_t* entry;
erts_refc_t rt_cnt; /* number of resource types */
erts_refc_t rt_dtor_cnt; /* number of resource types with destructors */
- int is_orphan; /* if erlang module has been purged */
+ Module* mod; /* Can be NULL if orphan with dtor-resources left */
};
#ifdef DEBUG
@@ -61,6 +61,10 @@ static void add_readonly_check(ErlNifEnv*, unsigned char* ptr, unsigned sz);
# define ADD_READONLY_CHECK(ENV,PTR,SIZE) ((void)0)
#endif
+#ifdef DEBUG
+static int is_offheap(const ErlOffHeap* off_heap);
+#endif
+
#define MIN_HEAP_FRAG_SZ 200
static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp);
@@ -84,7 +88,8 @@ static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp)
HEAP_TOP(env->proc) = env->hp;
}
else {
- HRelease(env->proc, env->hp_end, env->hp);
+ env->heap_frag->used_size = hp - env->heap_frag->mem;
+ ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
frag_sz = need + MIN_HEAP_FRAG_SZ;
hp = erts_heap_alloc(env->proc, frag_sz);
@@ -143,8 +148,9 @@ void erts_post_nif(ErlNifEnv* env)
}
else {
ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
- ASSERT(env->hp_end - env->hp <= env->heap_frag->size);
- HRelease(env->proc, env->hp_end, env->hp);
+ ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
+ env->heap_frag->used_size = env->hp - env->heap_frag->mem;
+ ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
free_tmp_objs(env);
}
@@ -158,7 +164,7 @@ static void post_nif_noproc(ErlNifEnv* env)
/* Flush out our cached heap pointers to allow an ordinary HAlloc
*/
-static void enable_halloc(ErlNifEnv* env)
+static void flush_env(ErlNifEnv* env)
{
if (env->heap_frag == NULL) {
ASSERT(env->hp_end == HEAP_LIMIT(env->proc));
@@ -168,14 +174,15 @@ static void enable_halloc(ErlNifEnv* env)
}
else {
ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
- ASSERT(env->hp_end - env->hp <= env->heap_frag->size);
- HRelease(env->proc, env->hp_end, env->hp);
+ ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
+ env->heap_frag->used_size = env->hp - env->heap_frag->mem;
+ ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
}
-/* Restore cached heap pointers
+/* Restore cached heap pointers to allow alloc_heap again.
*/
-static void disable_halloc(ErlNifEnv* env)
+static void cache_env(ErlNifEnv* env)
{
if (env->heap_frag == NULL) {
ASSERT(env->hp_end == HEAP_LIMIT(env->proc));
@@ -185,34 +192,192 @@ static void disable_halloc(ErlNifEnv* env)
}
else {
ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
- ASSERT(env->hp_end - env->hp <= env->heap_frag->size);
+ ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
env->heap_frag = MBUF(env->proc);
ASSERT(env->heap_frag != NULL);
env->hp = env->heap_frag->mem + env->heap_frag->used_size;
- env->hp_end = env->heap_frag->mem + env->heap_frag->size;
+ env->hp_end = env->heap_frag->mem + env->heap_frag->alloc_size;
}
}
-
void* enif_priv_data(ErlNifEnv* env)
{
return env->mod_nif->priv_data;
}
-void* enif_alloc(ErlNifEnv* env, size_t size)
+void* enif_alloc(size_t size)
{
return erts_alloc_fnf(ERTS_ALC_T_NIF, (Uint) size);
}
-void* enif_realloc(ErlNifEnv* env, void* ptr, size_t size)
+void* enif_realloc(void* ptr, size_t size)
{
return erts_realloc_fnf(ERTS_ALC_T_NIF, ptr, size);
}
-void enif_free(ErlNifEnv* env, void* ptr)
+void enif_free(void* ptr)
{
erts_free(ERTS_ALC_T_NIF, ptr);
}
+struct enif_msg_environment_t
+{
+ ErlNifEnv env;
+ Process phony_proc;
+};
+
+ErlNifEnv* enif_alloc_env(void)
+{
+ struct enif_msg_environment_t* msg_env =
+ erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t));
+ Eterm* phony_heap = (Eterm*) msg_env; /* dummy non-NULL ptr */
+
+ msg_env->env.hp = phony_heap;
+ 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.proc = &msg_env->phony_proc;
+ memset(&msg_env->phony_proc, 0, sizeof(Process));
+ HEAP_START(&msg_env->phony_proc) = phony_heap;
+ HEAP_TOP(&msg_env->phony_proc) = phony_heap;
+ HEAP_LIMIT(&msg_env->phony_proc) = phony_heap;
+ HEAP_END(&msg_env->phony_proc) = phony_heap;
+ MBUF(&msg_env->phony_proc) = NULL;
+ msg_env->phony_proc.id = ERTS_INVALID_PID;
+#ifdef FORCE_HEAP_FRAGS
+ msg_env->phony_proc.space_verified = 0;
+ msg_env->phony_proc.space_verified_from = NULL;
+#endif
+ return &msg_env->env;
+}
+void enif_free_env(ErlNifEnv* env)
+{
+ enif_clear_env(env);
+ erts_free(ERTS_ALC_T_NIF, env);
+}
+
+static ERTS_INLINE void clear_offheap(ErlOffHeap* oh)
+{
+ oh->mso = NULL;
+ oh->externals = NULL;
+ oh->funs = NULL;
+ oh->overhead = 0;
+}
+
+void enif_clear_env(ErlNifEnv* env)
+{
+ struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)env;
+ Process* p = &menv->phony_proc;
+ ASSERT(p == menv->env.proc);
+ ASSERT(p->id == ERTS_INVALID_PID);
+ ASSERT(MBUF(p) == menv->env.heap_frag);
+ if (MBUF(p) != NULL) {
+ erts_cleanup_offheap(&MSO(p));
+ clear_offheap(&MSO(p));
+ free_message_buffer(MBUF(p));
+ MBUF(p) = NULL;
+ menv->env.heap_frag = NULL;
+ }
+ ASSERT(HEAP_TOP(p) == HEAP_END(p));
+ menv->env.hp = menv->env.hp_end = HEAP_TOP(p);
+
+ ASSERT(!is_offheap(&MSO(p)));
+}
+int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
+ ErlNifEnv* msg_env, ERL_NIF_TERM msg)
+{
+ struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)msg_env;
+ ErtsProcLocks rp_locks = 0;
+ Process* rp;
+ Process* c_p;
+ ErlHeapFragment* frags;
+#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+ ErtsProcLocks rp_had_locks;
+#endif
+ Eterm receiver = to_pid->pid;
+ int flush_me = 0;
+
+ if (env != NULL) {
+ c_p = env->proc;
+ if (receiver == c_p->id) {
+ rp_locks = ERTS_PROC_LOCK_MAIN;
+ flush_me = 1;
+ }
+ }
+ else {
+#ifdef ERTS_SMP
+ c_p = NULL;
+#else
+ erl_exit(ERTS_ABORT_EXIT,"enif_send: env==NULL on non-SMP VM");
+#endif
+ }
+
+#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP)
+ rp_had_locks = rp_locks;
+#endif
+ rp = erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN,
+ receiver, rp_locks, ERTS_P2P_FLG_SMP_INC_REFC);
+ if (rp == NULL) {
+ ASSERT(env == NULL || receiver != c_p->id);
+ return 0;
+ }
+ flush_env(msg_env);
+ frags = menv->env.heap_frag;
+ ASSERT(frags == MBUF(&menv->phony_proc));
+ if (frags != NULL) {
+ /* Move all offheap's from phony proc to the first fragment.
+ Quick and dirty, but erts_move_msg_mbuf_to_heap doesn't care. */
+ ASSERT(!is_offheap(&frags->off_heap));
+ frags->off_heap = MSO(&menv->phony_proc);
+ clear_offheap(&MSO(&menv->phony_proc));
+ menv->env.heap_frag = NULL;
+ MBUF(&menv->phony_proc) = NULL;
+ }
+ ASSERT(!is_offheap(&MSO(&menv->phony_proc)));
+
+ if (flush_me) {
+ flush_env(env); /* Needed for ERTS_HOLE_CHECK */
+ }
+ erts_queue_message(rp, &rp_locks, frags, msg, am_undefined);
+ if (rp_locks) {
+ ERTS_SMP_LC_ASSERT(rp_locks == (rp_had_locks | (ERTS_PROC_LOCK_MSGQ |
+ ERTS_PROC_LOCK_STATUS)));
+ erts_smp_proc_unlock(rp, (ERTS_PROC_LOCK_MSGQ | ERTS_PROC_LOCK_STATUS));
+ }
+ erts_smp_proc_dec_refc(rp);
+ if (flush_me) {
+ cache_env(env);
+ }
+ return 1;
+}
+
+ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)
+{
+ Uint sz;
+ Eterm* hp;
+ sz = size_object(src_term);
+ hp = alloc_heap(dst_env, sz);
+ return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc));
+}
+
+
+#ifdef DEBUG
+static int is_offheap(const ErlOffHeap* oh)
+{
+ return oh->mso != NULL || oh->funs != NULL || oh->externals != NULL;
+}
+#endif
+
+ErlNifPid* enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)
+{
+ pid->pid = caller_env->proc->id;
+ return pid;
+}
+int enif_get_local_pid(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPid* pid)
+{
+ return is_internal_pid(term) ? (pid->pid=term, 1) : 0;
+}
+
int enif_is_atom(ErlNifEnv* env, ERL_NIF_TERM term)
{
return is_atom(term);
@@ -248,9 +413,19 @@ int enif_is_ref(ErlNifEnv* env, ERL_NIF_TERM term)
return is_ref(term);
}
+int enif_is_tuple(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return is_tuple(term);
+}
+
+int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return is_list(term) || is_nil(term);
+}
+
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
- erts_free_aligned_binary_bytes((byte*)obj);
+ erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP);
}
int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
@@ -260,7 +435,7 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
byte* raw_ptr;
}u;
u.tmp = NULL;
- bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr,
+ bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, ERTS_ALC_T_TMP,
sizeof(struct enif_tmp_obj_t));
if (bin->data == NULL) {
return 0;
@@ -314,7 +489,7 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
return 1;
}
-int enif_alloc_binary(ErlNifEnv* env, unsigned size, ErlNifBinary* bin)
+int enif_alloc_binary(size_t size, ErlNifBinary* bin)
{
Binary* refbin;
@@ -333,7 +508,7 @@ int enif_alloc_binary(ErlNifEnv* env, unsigned size, ErlNifBinary* bin)
return 1;
}
-int enif_realloc_binary(ErlNifEnv* env, ErlNifBinary* bin, unsigned size)
+int enif_realloc_binary(ErlNifBinary* bin, size_t size)
{
if (bin->ref_bin != NULL) {
Binary* oldbin;
@@ -351,15 +526,15 @@ int enif_realloc_binary(ErlNifEnv* env, ErlNifBinary* bin, unsigned size)
}
else {
unsigned char* old_data = bin->data;
- unsigned cpy_sz = (size < bin->size ? size : bin->size);
- enif_alloc_binary(env, size, bin);
+ size_t cpy_sz = (size < bin->size ? size : bin->size);
+ enif_alloc_binary(size, bin);
sys_memcpy(bin->data, old_data, cpy_sz);
}
return 1;
}
-void enif_release_binary(ErlNifEnv* env, ErlNifBinary* bin)
+void enif_release_binary(ErlNifBinary* bin)
{
if (bin->ref_bin != NULL) {
Binary* refbin = bin->ref_bin;
@@ -375,21 +550,21 @@ void enif_release_binary(ErlNifEnv* env, ErlNifBinary* bin)
#endif
}
-unsigned char* enif_make_new_binary(ErlNifEnv* env, unsigned size,
+unsigned char* enif_make_new_binary(ErlNifEnv* env, size_t size,
ERL_NIF_TERM* termp)
{
- enable_halloc(env);
+ flush_env(env);
*termp = new_binary(env->proc, NULL, size);
- disable_halloc(env);
+ cache_env(env);
return binary_bytes(*termp);
}
-int enif_is_identical(ErlNifEnv* env, Eterm lhs, Eterm rhs)
+int enif_is_identical(Eterm lhs, Eterm rhs)
{
return EQ(lhs,rhs);
}
-int enif_compare(ErlNifEnv* env, Eterm lhs, Eterm rhs)
+int enif_compare(Eterm lhs, Eterm rhs)
{
return cmp(lhs,rhs);
}
@@ -468,15 +643,15 @@ Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)
return bin_term;
}
else {
- enable_halloc(env);
+ flush_env(env);
bin->bin_term = new_binary(env->proc, bin->data, bin->size);
- disable_halloc(env);
+ cache_env(env);
return bin->bin_term;
}
}
Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
- unsigned pos, unsigned size)
+ size_t pos, size_t size)
{
ErlSubBin* sb;
Eterm orig;
@@ -506,9 +681,11 @@ Eterm enif_make_badarg(ErlNifEnv* env)
BIF_ERROR(env->proc, BADARG);
}
-int enif_get_atom(ErlNifEnv* env, Eterm atom, char* buf, unsigned len)
+int enif_get_atom(ErlNifEnv* env, Eterm atom, char* buf, unsigned len,
+ ErlNifCharEncoding encoding)
{
Atom* ap;
+ ASSERT(encoding == ERL_NIF_LATIN1);
if (is_not_atom(atom)) {
return 0;
}
@@ -556,10 +733,8 @@ int enif_get_long(ErlNifEnv* env, Eterm term, long* ip)
#if SIZEOF_LONG == ERTS_SIZEOF_ETERM
return term_to_Sint(term, ip);
#elif SIZEOF_INT == ERTS_SIZEOF_ETERM
- Uint u;
- term_to_Sint(term, u);
- *ip = (long) u;
- return 1;
+ Sint i;
+ return term_to_Sint(term, &i) ? (*ip = (long) i, 1) : 0;
#else
# error Unknown long word size
#endif
@@ -571,10 +746,7 @@ int enif_get_ulong(ErlNifEnv* env, Eterm term, unsigned long* ip)
return term_to_Uint(term, ip);
#elif SIZEOF_INT == ERTS_SIZEOF_ETERM
Uint u;
- int r;
- r = term_to_Uint(term, &u);
- *ip = (unsigned long) u;
- return r;
+ return term_to_Uint(term, &u) ? (*ip = (unsigned long) u, 1) : 0;
#else
# error Unknown long word size
#endif
@@ -591,6 +763,17 @@ int enif_get_double(ErlNifEnv* env, Eterm term, double* dp)
return 1;
}
+int enif_get_atom_length(ErlNifEnv* env, Eterm atom, unsigned* len,
+ ErlNifCharEncoding enc)
+{
+ Atom* ap;
+ ASSERT(enc == ERL_NIF_LATIN1);
+ if (is_not_atom(atom)) return 0;
+ ap = atom_tab(atom_val(atom));
+ *len = ap->len;
+ return 1;
+}
+
int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail)
{
Eterm* val;
@@ -601,6 +784,13 @@ int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail)
return 1;
}
+int enif_get_list_length(ErlNifEnv* env, Eterm term, unsigned* len)
+{
+ if (is_not_list(term) && is_not_nil(term)) return 0;
+ *len = list_length(term);
+ return 1;
+}
+
ERL_NIF_TERM enif_make_int(ErlNifEnv* env, int i)
{
#if SIZEOF_INT == ERTS_SIZEOF_ETERM
@@ -640,12 +830,25 @@ ERL_NIF_TERM enif_make_double(ErlNifEnv* env, double d)
ERL_NIF_TERM enif_make_atom(ErlNifEnv* env, const char* name)
{
- return am_atom_put(name, sys_strlen(name));
+ return enif_make_atom_len(env, name, sys_strlen(name));
+}
+
+ERL_NIF_TERM enif_make_atom_len(ErlNifEnv* env, const char* name, size_t len)
+{
+ return am_atom_put(name, len);
+}
+
+int enif_make_existing_atom(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom,
+ ErlNifCharEncoding enc)
+{
+ return enif_make_existing_atom_len(env, name, sys_strlen(name), atom, enc);
}
-int enif_make_existing_atom(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom)
+int enif_make_existing_atom_len(ErlNifEnv* env, const char* name, size_t len,
+ ERL_NIF_TERM* atom, ErlNifCharEncoding encoding)
{
- return erts_atom_get(name, sys_strlen(name), atom);
+ ASSERT(encoding == ERL_NIF_LATIN1);
+ return erts_atom_get(name, len, atom);
}
ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...)
@@ -724,11 +927,16 @@ ERL_NIF_TERM enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[],
ERL_NIF_TERM enif_make_string(ErlNifEnv* env, const char* string,
ErlNifCharEncoding encoding)
-{
- Sint n = sys_strlen(string);
- Eterm* hp = alloc_heap(env,n*2);
+{
+ return enif_make_string_len(env, string, sys_strlen(string), encoding);
+}
+
+ERL_NIF_TERM enif_make_string_len(ErlNifEnv* env, const char* string,
+ size_t len, ErlNifCharEncoding encoding)
+{
+ Eterm* hp = alloc_heap(env,len*2);
ASSERT(encoding == ERL_NIF_LATIN1);
- return erts_bld_string_n(&hp,NULL,string,n);
+ return erts_bld_string_n(&hp,NULL,string,len);
}
ERL_NIF_TERM enif_make_ref(ErlNifEnv* env)
@@ -799,7 +1007,8 @@ struct enif_resource_type_t
ErlNifResourceDtor* dtor; /* user destructor function */
erts_refc_t refc; /* num of resources of this type (HOTSPOT warning)
+1 for active erl_module_nif */
- char name[1];
+ Eterm module;
+ Eterm name;
};
/* dummy node in circular list */
@@ -817,14 +1026,14 @@ typedef struct enif_resource_t
#define SIZEOF_ErlNifResource(SIZE) (offsetof(ErlNifResource,data) + (SIZE))
#define DATA_TO_RESOURCE(PTR) ((ErlNifResource*)((char*)(PTR) - offsetof(ErlNifResource,data)))
-static ErlNifResourceType* find_resource_type(const char* name)
+static ErlNifResourceType* find_resource_type(Eterm module, Eterm name)
{
ErlNifResourceType* type;
for (type = resource_type_list.next;
type != &resource_type_list;
type = type->next) {
- if (sys_strcmp(type->name, name) == 0) {
+ if (type->module == module && type->name == name) {
return type;
}
}
@@ -857,33 +1066,42 @@ static void steal_resource_type(ErlNifResourceType* type)
if (type->dtor != NULL
&& erts_refc_dectest(&lib->rt_dtor_cnt, 0) == 0
- && lib->is_orphan) {
+ && lib->mod == NULL) {
/* last type with destructor gone, close orphan lib */
close_lib(lib);
}
if (erts_refc_dectest(&lib->rt_cnt, 0) == 0
- && lib->is_orphan) {
+ && lib->mod == NULL) {
erts_free(ERTS_ALC_T_NIF, lib);
}
}
ErlNifResourceType*
-enif_open_resource_type(ErlNifEnv* env, const char* type_name,
- ErlNifResourceDtor* dtor,
- enum ErlNifResourceFlags flags,
- enum ErlNifResourceFlags* tried)
+enif_open_resource_type(ErlNifEnv* env,
+ const char* module_str,
+ const char* name_str,
+ ErlNifResourceDtor* dtor,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried)
{
- ErlNifResourceType* type = find_resource_type(type_name);
- enum ErlNifResourceFlags op = flags;
+ ErlNifResourceType* type = NULL;
+ ErlNifResourceFlags op = flags;
+ Eterm module_am, name_am;
+
ASSERT(erts_smp_is_system_blocked(0));
+ ASSERT(module_str == NULL); /* for now... */
+ module_am = make_atom(env->mod_nif->mod->module);
+ name_am = enif_make_atom(env, name_str);
+
+ type = find_resource_type(module_am, name_am);
if (type == NULL) {
if (flags & ERL_NIF_RT_CREATE) {
type = erts_alloc(ERTS_ALC_T_NIF,
- sizeof(struct enif_resource_type_t)
- + sys_strlen(type_name));
+ sizeof(struct enif_resource_type_t));
type->dtor = dtor;
- sys_strcpy(type->name, type_name);
+ type->module = module_am;
+ type->name = name_am;
erts_refc_init(&type->refc, 1);
type->owner = env->mod_nif;
type->prev = &resource_type_list;
@@ -931,13 +1149,13 @@ static void nif_resource_dtor(Binary* bin)
if (erts_refc_dectest(&type->refc, 0) == 0) {
ASSERT(type->next == NULL);
ASSERT(type->owner != NULL);
- ASSERT(type->owner->is_orphan);
+ ASSERT(type->owner->mod == NULL);
steal_resource_type(type);
erts_free(ERTS_ALC_T_NIF, type);
}
}
-void* enif_alloc_resource(ErlNifEnv* env, ErlNifResourceType* type, unsigned size)
+void* enif_alloc_resource(ErlNifResourceType* type, size_t size)
{
Binary* bin = erts_create_magic_binary(SIZEOF_ErlNifResource(size), &nif_resource_dtor);
ErlNifResource* resource = ERTS_MAGIC_BIN_DATA(bin);
@@ -950,7 +1168,7 @@ void* enif_alloc_resource(ErlNifEnv* env, ErlNifResourceType* type, unsigned siz
return resource->data;
}
-void enif_release_resource(ErlNifEnv* env, void* obj)
+void enif_release_resource(void* obj)
{
ErlNifResource* resource = DATA_TO_RESOURCE(obj);
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_DATA(resource);
@@ -964,6 +1182,18 @@ void enif_release_resource(ErlNifEnv* env, void* obj)
}
}
+void enif_keep_resource(void* obj)
+{
+ ErlNifResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_DATA(resource);
+
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+#ifdef DEBUG
+ erts_refc_inc(&resource->nif_refc, 1);
+#endif
+ erts_refc_inc(&bin->binary.refc, 2);
+}
+
ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj)
{
ErlNifResource* resource = DATA_TO_RESOURCE(obj);
@@ -972,15 +1202,30 @@ ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj)
return erts_mk_magic_binary_term(&hp, &MSO(env->proc), &bin->binary);
}
+ERL_NIF_TERM enif_make_resource_binary(ErlNifEnv* env, void* obj,
+ const void* data, size_t size)
+{
+ Eterm bin = enif_make_resource(env, obj);
+ ProcBin* pb = (ProcBin*) binary_val(bin);
+ pb->bytes = (byte*) data;
+ pb->size = size;
+ return bin;
+}
+
int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type,
void** objp)
{
+ ProcBin* pb;
Binary* mbin;
ErlNifResource* resource;
if (!ERTS_TERM_IS_MAGIC_BINARY(term)) {
return 0;
}
- mbin = ((ProcBin*) binary_val(term))->val;
+ pb = (ProcBin*) binary_val(term);
+ /*if (pb->size != 0) {
+ return 0; / * Or should we allow "resource binaries" as handles? * /
+ }*/
+ mbin = pb->val;
resource = (ErlNifResource*) ERTS_MAGIC_BIN_DATA(mbin);
if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != &nif_resource_dtor
|| resource->type != type) {
@@ -990,7 +1235,7 @@ int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* typ
return 1;
}
-unsigned enif_sizeof_resource(ErlNifEnv* env, void* obj)
+size_t enif_sizeof_resource(void* obj)
{
ErlNifResource* resource = DATA_TO_RESOURCE(obj);
Binary* bin = &ERTS_MAGIC_BIN_FROM_DATA(resource)->binary;
@@ -1220,7 +1465,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
lib->entry = entry;
erts_refc_init(&lib->rt_cnt, 0);
erts_refc_init(&lib->rt_dtor_cnt, 0);
- lib->is_orphan = 0;
+ lib->mod = mod;
env.mod_nif = lib;
if (mod->nif != NULL) { /* Reload */
int k;
@@ -1334,7 +1579,7 @@ erts_unload_nif(struct erl_module_nif* lib)
ErlNifResourceType* next;
ASSERT(erts_smp_is_system_blocked(0));
ASSERT(lib != NULL);
- ASSERT(!lib->is_orphan);
+ ASSERT(lib->mod != NULL);
for (rt = resource_type_list.next;
rt != &resource_type_list;
rt = next) {
@@ -1364,7 +1609,7 @@ erts_unload_nif(struct erl_module_nif* lib)
else {
ASSERT(erts_refc_read(&lib->rt_cnt, 1) > 0);
}
- lib->is_orphan = 1;
+ lib->mod = NULL; /* orphan lib */
}
void erl_nif_init()
@@ -1373,7 +1618,8 @@ void erl_nif_init()
resource_type_list.prev = &resource_type_list;
resource_type_list.dtor = NULL;
resource_type_list.owner = NULL;
- resource_type_list.name[0] = '\0';
+ resource_type_list.module = THE_NON_VALUE;
+ resource_type_list.name = THE_NON_VALUE;
}
#ifdef READONLY_CHECK
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index a345837569..936f03bce1 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -23,14 +23,16 @@
#ifndef __ERL_NIF_H__
#define __ERL_NIF_H__
+
#include "erl_drv_nif.h"
/* Version history:
** 0.1: R13B03
** 1.0: R13B04
+** 2.0: R14A
*/
-#define ERL_NIF_MAJOR_VERSION 1
-#define ERL_NIF_MINOR_VERSION 1
+#define ERL_NIF_MAJOR_VERSION 2
+#define ERL_NIF_MINOR_VERSION 0
#include <stdlib.h>
@@ -60,6 +62,10 @@
#endif
#include "erl_int_sizes_config.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
#ifdef HALFWORD_HEAP_EMULATOR
typedef unsigned int ERL_NIF_TERM;
#else
@@ -93,7 +99,7 @@ typedef struct enif_entry_t
typedef struct
{
- unsigned size;
+ size_t size;
unsigned char* data;
/* Internals (avert your eyes) */
@@ -103,17 +109,22 @@ typedef struct
typedef struct enif_resource_type_t ErlNifResourceType;
typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
-enum ErlNifResourceFlags
+typedef enum
{
ERL_NIF_RT_CREATE = 1,
ERL_NIF_RT_TAKEOVER = 2
-};
+}ErlNifResourceFlags;
typedef enum
{
ERL_NIF_LATIN1 = 1
}ErlNifCharEncoding;
+typedef struct
+{
+ ERL_NIF_TERM pid; /* internal, may change */
+}ErlNifPid;
+
typedef ErlDrvSysInfo ErlNifSysInfo;
typedef struct ErlDrvTid_ *ErlNifTid;
@@ -146,8 +157,6 @@ extern TWinDynNifCallbacks WinDynNifCallbacks;
#endif
-
-
#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks;
# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks)
@@ -163,7 +172,18 @@ extern TWinDynNifCallbacks WinDynNifCallbacks;
#endif
+#ifdef __cplusplus
+}
+# define ERL_NIF_INIT_PROLOGUE extern "C" {
+# define ERL_NIF_INIT_EPILOGUE }
+#else
+# define ERL_NIF_INIT_PROLOGUE
+# define ERL_NIF_INIT_EPILOGUE
+#endif
+
+
#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \
+ERL_NIF_INIT_PROLOGUE \
ERL_NIF_INIT_GLOB \
ERL_NIF_INIT_DECL(NAME) \
{ \
@@ -178,7 +198,9 @@ ERL_NIF_INIT_DECL(NAME) \
}; \
ERL_NIF_INIT_BODY; \
return &entry; \
-}
+} \
+ERL_NIF_INIT_EPILOGUE
+
#endif /* __ERL_NIF_H__ */
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index fe8d2664e1..ef4e9580b0 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -23,29 +23,29 @@
#ifdef ERL_NIF_API_FUNC_DECL
ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*));
-ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(ErlNifEnv*, size_t size));
-ERL_NIF_API_FUNC_DECL(void,enif_free,(ErlNifEnv*, void* ptr));
+ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_free,(void* ptr));
ERL_NIF_API_FUNC_DECL(int,enif_is_atom,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int,enif_is_binary,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int,enif_is_ref,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int,enif_inspect_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, ErlNifBinary* bin));
-ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(ErlNifEnv*, unsigned size, ErlNifBinary* bin));
-ERL_NIF_API_FUNC_DECL(int,enif_realloc_binary,(ErlNifEnv*, ErlNifBinary* bin, unsigned size));
-ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifEnv*, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(size_t size, ErlNifBinary* bin));
+ERL_NIF_API_FUNC_DECL(int,enif_realloc_binary,(ErlNifBinary* bin, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifBinary* bin));
ERL_NIF_API_FUNC_DECL(int,enif_get_int,(ErlNifEnv*, ERL_NIF_TERM term, int* ip));
ERL_NIF_API_FUNC_DECL(int,enif_get_ulong,(ErlNifEnv*, ERL_NIF_TERM term, unsigned long* ip));
ERL_NIF_API_FUNC_DECL(int,enif_get_double,(ErlNifEnv*, ERL_NIF_TERM term, double* dp));
ERL_NIF_API_FUNC_DECL(int,enif_get_list_cell,(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM* head, ERL_NIF_TERM* tail));
ERL_NIF_API_FUNC_DECL(int,enif_get_tuple,(ErlNifEnv* env, ERL_NIF_TERM tpl, int* arity, const ERL_NIF_TERM** array));
-ERL_NIF_API_FUNC_DECL(int,enif_is_identical,(ErlNifEnv* env, ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
-ERL_NIF_API_FUNC_DECL(int,enif_compare,(ErlNifEnv* env, ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
+ERL_NIF_API_FUNC_DECL(int,enif_is_identical,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
+ERL_NIF_API_FUNC_DECL(int,enif_compare,(ERL_NIF_TERM lhs, ERL_NIF_TERM rhs));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_binary,(ErlNifEnv* env, ErlNifBinary* bin));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_badarg,(ErlNifEnv* env));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int,(ErlNifEnv* env, int i));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ulong,(ErlNifEnv* env, unsigned long i));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_double,(ErlNifEnv* env, double d));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_atom,(ErlNifEnv* env, const char* name));
-ERL_NIF_API_FUNC_DECL(int,enif_make_existing_atom,(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom));
+ERL_NIF_API_FUNC_DECL(int,enif_make_existing_atom,(ErlNifEnv* env, const char* name, ERL_NIF_TERM* atom, ErlNifCharEncoding));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple,(ErlNifEnv* env, unsigned cnt, ...));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list,(ErlNifEnv* env, unsigned cnt, ...));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_cell,(ErlNifEnv* env, ERL_NIF_TERM car, ERL_NIF_TERM cdr));
@@ -82,13 +82,13 @@ ERL_NIF_API_FUNC_DECL(int,enif_equal_tids,(ErlNifTid tid1, ErlNifTid tid2));
ERL_NIF_API_FUNC_DECL(void,enif_thread_exit,(void *resp));
ERL_NIF_API_FUNC_DECL(int,enif_thread_join,(ErlNifTid, void **respp));
-ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(ErlNifEnv*, void* ptr, size_t size));
+ERL_NIF_API_FUNC_DECL(void*,enif_realloc,(void* ptr, size_t size));
ERL_NIF_API_FUNC_DECL(void,enif_system_info,(ErlNifSysInfo *sip, size_t si_size));
ERL_NIF_API_FUNC_DECL(int,enif_fprintf,(void/* FILE* */ *filep, const char *format, ...));
ERL_NIF_API_FUNC_DECL(int,enif_inspect_iolist_as_binary,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifBinary* bin));
-ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, unsigned pos, unsigned size));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_sub_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, size_t pos, size_t size));
ERL_NIF_API_FUNC_DECL(int,enif_get_string,(ErlNifEnv*, ERL_NIF_TERM list, char* buf, unsigned len, ErlNifCharEncoding));
-ERL_NIF_API_FUNC_DECL(int,enif_get_atom,(ErlNifEnv*, ERL_NIF_TERM atom, char* buf, unsigned len));
+ERL_NIF_API_FUNC_DECL(int,enif_get_atom,(ErlNifEnv*, ERL_NIF_TERM atom, char* buf, unsigned len, ErlNifCharEncoding));
ERL_NIF_API_FUNC_DECL(int,enif_is_fun,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int,enif_is_pid,(ErlNifEnv*, ERL_NIF_TERM term));
ERL_NIF_API_FUNC_DECL(int,enif_is_port,(ErlNifEnv*, ERL_NIF_TERM term));
@@ -99,13 +99,29 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_long,(ErlNifEnv*, long i));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_from_array,(ErlNifEnv*, const ERL_NIF_TERM arr[], unsigned cnt));
ERL_NIF_API_FUNC_DECL(int,enif_is_empty_list,(ErlNifEnv*, ERL_NIF_TERM term));
-ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type,(ErlNifEnv*, const char* type_name, void (*dtor)(ErlNifEnv*,void *), enum ErlNifResourceFlags flags, enum ErlNifResourceFlags* tried));
-ERL_NIF_API_FUNC_DECL(void*,enif_alloc_resource,(ErlNifEnv*, ErlNifResourceType* type, unsigned size));
-ERL_NIF_API_FUNC_DECL(void,enif_release_resource,(ErlNifEnv*, void* obj));
+ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type,(ErlNifEnv*, const char* module_str, const char* name_str, void (*dtor)(ErlNifEnv*,void *), ErlNifResourceFlags flags, ErlNifResourceFlags* tried));
+ERL_NIF_API_FUNC_DECL(void*,enif_alloc_resource,(ErlNifResourceType* type, size_t size));
+ERL_NIF_API_FUNC_DECL(void,enif_release_resource,(void* obj));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource,(ErlNifEnv*, void* obj));
ERL_NIF_API_FUNC_DECL(int,enif_get_resource,(ErlNifEnv*, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp));
-ERL_NIF_API_FUNC_DECL(unsigned,enif_sizeof_resource,(ErlNifEnv*, void* obj));
-ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,unsigned size,ERL_NIF_TERM* termp));
+ERL_NIF_API_FUNC_DECL(size_t,enif_sizeof_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,size_t size,ERL_NIF_TERM* termp));
+ERL_NIF_API_FUNC_DECL(int,enif_is_list,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_is_tuple,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_get_atom_length,(ErlNifEnv*, ERL_NIF_TERM atom, unsigned* len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(int,enif_get_list_length,(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_atom_len,(ErlNifEnv* env, const char* name, size_t len));
+ERL_NIF_API_FUNC_DECL(int, enif_make_existing_atom_len,(ErlNifEnv* env, const char* name, size_t len, ERL_NIF_TERM* atom, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string_len,(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding));
+ERL_NIF_API_FUNC_DECL(ErlNifEnv*,enif_alloc_env,(void));
+ERL_NIF_API_FUNC_DECL(void,enif_free_env,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(void,enif_clear_env,(ErlNifEnv* env));
+ERL_NIF_API_FUNC_DECL(int,enif_send,(ErlNifEnv* env, const ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_copy,(ErlNifEnv* dst_env, ERL_NIF_TERM src_term));
+ERL_NIF_API_FUNC_DECL(ErlNifPid*,enif_self,(ErlNifEnv* caller_env, ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(int,enif_get_local_pid,(ErlNifEnv* env, ERL_NIF_TERM, ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(void,enif_keep_resource,(void* obj));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_resource_binary,(ErlNifEnv*,void* obj,const void* data, size_t size));
/*
** Add last to keep compatibility on Windows!!!
@@ -198,6 +214,22 @@ ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,unsigned s
# define enif_get_resource ERL_NIF_API_FUNC_MACRO(enif_get_resource)
# define enif_sizeof_resource ERL_NIF_API_FUNC_MACRO(enif_sizeof_resource)
# define enif_make_new_binary ERL_NIF_API_FUNC_MACRO(enif_make_new_binary)
+# define enif_is_list ERL_NIF_API_FUNC_MACRO(enif_is_list)
+# define enif_is_tuple ERL_NIF_API_FUNC_MACRO(enif_is_tuple)
+# define enif_get_atom_length ERL_NIF_API_FUNC_MACRO(enif_get_atom_length)
+# define enif_get_list_length ERL_NIF_API_FUNC_MACRO(enif_get_list_length)
+# define enif_make_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_atom_len)
+# define enif_make_existing_atom_len ERL_NIF_API_FUNC_MACRO(enif_make_existing_atom_len)
+# define enif_make_string_len ERL_NIF_API_FUNC_MACRO(enif_make_string_len)
+# define enif_alloc_env ERL_NIF_API_FUNC_MACRO(enif_alloc_env)
+# define enif_free_env ERL_NIF_API_FUNC_MACRO(enif_free_env)
+# define enif_clear_env ERL_NIF_API_FUNC_MACRO(enif_clear_env)
+# define enif_send ERL_NIF_API_FUNC_MACRO(enif_send)
+# define enif_make_copy ERL_NIF_API_FUNC_MACRO(enif_make_copy)
+# define enif_self ERL_NIF_API_FUNC_MACRO(enif_self)
+# define enif_get_local_pid ERL_NIF_API_FUNC_MACRO(enif_get_local_pid)
+# define enif_keep_resource ERL_NIF_API_FUNC_MACRO(enif_keep_resource)
+# define enif_make_resource_binary ERL_NIF_API_FUNC_MACRO(enif_make_resource_binary)
#endif
#ifndef enif_make_list1
@@ -219,9 +251,7 @@ ERL_NIF_API_FUNC_DECL(unsigned char*,enif_make_new_binary,(ErlNifEnv*,unsigned s
# 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
-#ifndef enif_get_data
-# define enif_get_data enif_priv_data /* deprecated */
+# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid))
#endif
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 0b6bb0d8e9..967a14f0d1 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -969,11 +969,11 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
erts_port_release(pp);
#else
{
- long refc = erts_smp_atomic_dectest(&pp->refc);
+ long refc;
+ erts_smp_mtx_unlock(pp->lock);
+ refc = erts_smp_atomic_dectest(&pp->refc);
ASSERT(refc >= 0);
- if (refc > 0)
- erts_smp_mtx_unlock(pp->lock);
- else {
+ if (refc == 0) {
erts_smp_runq_unlock(runq);
erts_port_cleanup(pp); /* Might aquire runq lock */
erts_smp_runq_lock(runq);
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 11ca85a41c..055733ac49 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -180,6 +180,7 @@ static ErtsCpuBindData *scheduler2cpu_map;
erts_smp_rwmtx_t erts_cpu_bind_rwmtx;
typedef enum {
+ ERTS_CPU_BIND_UNDEFINED,
ERTS_CPU_BIND_SPREAD,
ERTS_CPU_BIND_PROCESSOR_SPREAD,
ERTS_CPU_BIND_THREAD_SPREAD,
@@ -190,6 +191,9 @@ typedef enum {
ERTS_CPU_BIND_NONE
} ErtsCpuBindOrder;
+#define ERTS_CPU_BIND_DEFAULT_BIND \
+ ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD
+
ErtsCpuBindOrder cpu_bind_order;
static erts_cpu_topology_t *user_cpudata;
@@ -2078,12 +2082,14 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
erts_aligned_run_queues = erts_alloc(ERTS_ALC_T_RUNQS,
(sizeof(ErtsAlignedRunQueue)*(n+1)));
- if ((((UWord) erts_aligned_run_queues) & ERTS_CACHE_LINE_MASK) == 0)
+ if ((((UWord) erts_aligned_run_queues) & ERTS_CACHE_LINE_MASK) != 0)
erts_aligned_run_queues = ((ErtsAlignedRunQueue *)
((((UWord) erts_aligned_run_queues)
& ~ERTS_CACHE_LINE_MASK)
+ ERTS_CACHE_LINE_SIZE));
+ ASSERT((((UWord) erts_aligned_run_queues) & ERTS_CACHE_LINE_MASK) == 0);
+
#ifdef ERTS_SMP
erts_smp_atomic_init(&no_empty_run_queues, 0);
#endif
@@ -2175,11 +2181,14 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
erts_aligned_scheduler_data = erts_alloc(ERTS_ALC_T_SCHDLR_DATA,
(sizeof(ErtsAlignedSchedulerData)
*(n+1)));
- if ((((UWord) erts_aligned_scheduler_data) & ERTS_CACHE_LINE_MASK) == 0)
+ if ((((UWord) erts_aligned_scheduler_data) & ERTS_CACHE_LINE_MASK) != 0)
erts_aligned_scheduler_data = ((ErtsAlignedSchedulerData *)
((((UWord) erts_aligned_scheduler_data)
& ~ERTS_CACHE_LINE_MASK)
+ ERTS_CACHE_LINE_SIZE));
+
+ ASSERT((((UWord) erts_aligned_scheduler_data) & ERTS_CACHE_LINE_MASK) == 0);
+
for (ix = 0; ix < n; ix++) {
ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix);
#ifdef ERTS_SMP
@@ -2769,7 +2778,7 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all)
res = ERTS_SCHDLR_SSPND_YIELD_RESTART; /* Yield */
}
else if (on) { /* ------ BLOCK ------ */
- if (erts_is_multi_scheduling_blocked()) {
+ if (schdlr_sspnd.msb.procs) {
plp = proclist_create(p);
plp->next = schdlr_sspnd.msb.procs;
schdlr_sspnd.msb.procs = plp;
@@ -2975,8 +2984,11 @@ erts_dbg_multi_scheduling_return_trap(Process *p, Eterm return_value)
int
erts_is_multi_scheduling_blocked(void)
{
- return (erts_smp_atomic_read(&schdlr_sspnd.msb.ongoing)
- && erts_smp_atomic_read(&schdlr_sspnd.active) == 1);
+ int res;
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ res = schdlr_sspnd.msb.procs != NULL;
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ return res;
}
Eterm
@@ -2985,7 +2997,7 @@ erts_multi_scheduling_blockers(Process *p)
Eterm res = NIL;
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- if (erts_is_multi_scheduling_blocked()) {
+ if (schdlr_sspnd.msb.procs) {
Eterm *hp, *hp_end;
ErtsProcList *plp1, *plp2;
Uint max_size;
@@ -3503,14 +3515,15 @@ erts_init_scheduler_bind_type(char *how)
if (!system_cpudata && !user_cpudata)
return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY;
- if (sys_strcmp(how, "s") == 0)
+ if (sys_strcmp(how, "db") == 0)
+ cpu_bind_order = ERTS_CPU_BIND_DEFAULT_BIND;
+ else if (sys_strcmp(how, "s") == 0)
cpu_bind_order = ERTS_CPU_BIND_SPREAD;
else if (sys_strcmp(how, "ps") == 0)
cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD;
else if (sys_strcmp(how, "ts") == 0)
cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD;
- else if (sys_strcmp(how, "db") == 0
- || sys_strcmp(how, "tnnps") == 0)
+ else if (sys_strcmp(how, "tnnps") == 0)
cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD;
else if (sys_strcmp(how, "nnps") == 0)
cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD;
@@ -4153,14 +4166,15 @@ erts_bind_schedulers(Process *c_p, Eterm how)
old_cpu_bind_order = cpu_bind_order;
- if (ERTS_IS_ATOM_STR("spread", how))
+ if (ERTS_IS_ATOM_STR("default_bind", how))
+ cpu_bind_order = ERTS_CPU_BIND_DEFAULT_BIND;
+ else if (ERTS_IS_ATOM_STR("spread", how))
cpu_bind_order = ERTS_CPU_BIND_SPREAD;
else if (ERTS_IS_ATOM_STR("processor_spread", how))
cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD;
else if (ERTS_IS_ATOM_STR("thread_spread", how))
cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD;
- else if (ERTS_IS_ATOM_STR("default_bind", how)
- || ERTS_IS_ATOM_STR("thread_no_node_processor_spread", how))
+ else if (ERTS_IS_ATOM_STR("thread_no_node_processor_spread", how))
cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD;
else if (ERTS_IS_ATOM_STR("no_node_processor_spread", how))
cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD;
@@ -4206,14 +4220,15 @@ erts_fake_scheduler_bindings(Process *p, Eterm how)
int cpudata_size;
Eterm res;
- if (ERTS_IS_ATOM_STR("spread", how))
+ if (ERTS_IS_ATOM_STR("default_bind", how))
+ fake_cpu_bind_order = ERTS_CPU_BIND_DEFAULT_BIND;
+ else if (ERTS_IS_ATOM_STR("spread", how))
fake_cpu_bind_order = ERTS_CPU_BIND_SPREAD;
else if (ERTS_IS_ATOM_STR("processor_spread", how))
fake_cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD;
else if (ERTS_IS_ATOM_STR("thread_spread", how))
fake_cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD;
- else if (ERTS_IS_ATOM_STR("default_bind", how)
- || ERTS_IS_ATOM_STR("thread_no_node_processor_spread", how))
+ else if (ERTS_IS_ATOM_STR("thread_no_node_processor_spread", how))
fake_cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD;
else if (ERTS_IS_ATOM_STR("no_node_processor_spread", how))
fake_cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD;
@@ -4438,7 +4453,7 @@ early_cpu_bind_init(void)
(sizeof(erts_cpu_topology_t)
* system_cpudata_size));
- cpu_bind_order = ERTS_CPU_BIND_NONE;
+ cpu_bind_order = ERTS_CPU_BIND_UNDEFINED;
if (!erts_get_cpu_topology(erts_cpuinfo, system_cpudata)
|| ERTS_INIT_CPU_TOPOLOGY_OK != verify_topology(system_cpudata,
@@ -4464,6 +4479,17 @@ late_cpu_bind_init(void)
scheduler2cpu_map[ix].bound_id = -1;
}
+ if (cpu_bind_order == ERTS_CPU_BIND_UNDEFINED) {
+ int ncpus = erts_get_cpu_configured(erts_cpuinfo);
+ if (ncpus < 1 || erts_no_schedulers < ncpus)
+ cpu_bind_order = ERTS_CPU_BIND_NONE;
+ else
+ cpu_bind_order = ((system_cpudata || user_cpudata)
+ && (erts_bind_to_cpu(erts_cpuinfo, -1) != -ENOTSUP)
+ ? ERTS_CPU_BIND_DEFAULT_BIND
+ : ERTS_CPU_BIND_NONE);
+ }
+
if (cpu_bind_order != ERTS_CPU_BIND_NONE) {
erts_cpu_topology_t *cpudata;
int cpudata_size;
@@ -7187,8 +7213,6 @@ erts_debug_verify_clean_empty_process(Process* p)
void
erts_cleanup_empty_process(Process* p)
{
- ErlHeapFragment* mbufp;
-
/* We only check fields that are known to be used... */
erts_cleanup_offheap(&p->off_heap);
@@ -7199,13 +7223,10 @@ erts_cleanup_empty_process(Process* p)
p->off_heap.externals = NULL;
p->off_heap.overhead = 0;
- mbufp = p->mbuf;
- while (mbufp) {
- ErlHeapFragment *next = mbufp->next;
- free_message_buffer(mbufp);
- mbufp = next;
+ if (p->mbuf != NULL) {
+ free_message_buffer(p->mbuf);
+ p->mbuf = NULL;
}
- p->mbuf = NULL;
#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP)
erts_lcnt_proc_lock_destroy(p);
#endif
@@ -7221,7 +7242,6 @@ static void
delete_process(Process* p)
{
ErlMessage* mp;
- ErlHeapFragment* bp;
VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->id));
@@ -7271,11 +7291,8 @@ delete_process(Process* p)
/*
* Free all pending message buffers.
*/
- bp = p->mbuf;
- while (bp != NULL) {
- ErlHeapFragment* next_bp = bp->next;
- free_message_buffer(bp);
- bp = next_bp;
+ if (p->mbuf != NULL) {
+ free_message_buffer(p->mbuf);
}
erts_erase_dicts(p);
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index cbcdec4ba7..e2cb523cf5 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -765,7 +765,7 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp)
{
ErlHeapFragment* hf = MBUF(p);
- ASSERT(hf!=NULL && (hp - hf->mem < (unsigned long)hf->size));
+ ASSERT(hf!=NULL && (hp - hf->mem < (unsigned long)hf->alloc_size));
hf->used_size = hp - hf->mem;
}
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index d635916dd8..21f85bd045 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 2001-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 2001-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
* 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%
*/
@@ -34,6 +34,8 @@
#include "erl_lock_count.h"
#include "erl_term.h"
+#define ERTS_THR_MEMORY_BARRIER ETHR_MEMORY_BARRIER
+
#ifdef ERTS_ENABLE_LOCK_COUNT
#define erts_mtx_lock(L) erts_mtx_lock_x(L, __FILE__, __LINE__)
#define erts_spin_lock(L) erts_spin_lock_x(L, __FILE__, __LINE__)
@@ -122,6 +124,8 @@ __decl_noreturn void __noreturn erts_thr_fatal_error(int, char *);
#else /* #ifdef USE_THREADS */
+#define ERTS_THR_MEMORY_BARRIER
+
#define ERTS_THR_OPTS_DEFAULT_INITER 0
typedef int erts_thr_opts_t;
typedef int erts_thr_init_data_t;
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 8addfcf5ad..381a182e39 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -1941,11 +1941,13 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
Eterm* hp;
int need;
+ ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0) || erts_is_system_blocked(0));
if (is_internal_port(t_p->tracer_proc)) {
#define LOCAL_HEAP_SIZE (5+5)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
+
hp = local_heap;
mess = TUPLE4(hp, am_trace, t_p->id, what, data);
hp += 5;
@@ -2727,6 +2729,8 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
Eterm mess;
Eterm* hp;
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_is_system_blocked(0));
+
if (is_internal_port(t_p->tracer_proc)) {
#define LOCAL_HEAP_SIZE (5+5)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 235bd7931d..cd63401581 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -61,8 +61,9 @@
/*
* The new arithmetic operations need some extra X registers in the register array.
+ * so does the gc_bif's (i_gc_bif3 need 3 extra).
*/
-#define ERTS_X_REGS_ALLOCATED (MAX_REG+2)
+#define ERTS_X_REGS_ALLOCATED (MAX_REG+3)
#define INPUT_REDUCTIONS (2 * CONTEXT_REDS)
@@ -83,6 +84,7 @@
#define ErtsHAllocLockCheck(P) \
ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks((P))) \
+ || ((P)->id == ERTS_INVALID_PID) \
|| ((P)->scheduler_data \
&& (P) == (P)->scheduler_data->match_pseudo_process) \
|| erts_is_system_blocked(0))
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index fbb40e4202..19dd3d6f97 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -881,6 +881,8 @@ Eterm copy_object(Eterm, Process*);
Uint size_object(Eterm);
Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
+void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
+ Eterm* refs, unsigned nrefs);
#ifdef HYBRID
#define RRMA_DEFAULT_SIZE 256
@@ -1078,6 +1080,7 @@ Eterm erts_heap_sizes(Process* p);
void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*);
void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*);
void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*);
+void erts_free_heap_frags(Process* p);
#ifdef HYBRID
int erts_global_garbage_collect(Process*, int, Eterm*, int);
@@ -1192,12 +1195,11 @@ erts_smp_port_unlock(Port *prt)
{
#ifdef ERTS_SMP
long refc;
+ erts_smp_mtx_unlock(prt->lock);
refc = erts_smp_atomic_dectest(&prt->refc);
ASSERT(refc >= 0);
if (refc == 0)
erts_port_cleanup(prt);
- else
- erts_smp_mtx_unlock(prt->lock);
#endif
}
@@ -1576,6 +1578,10 @@ void erts_init_bif_chksum(void);
/* erl_bif_re.c */
void erts_init_bif_re(void);
Sint erts_re_set_loop_limit(Sint limit);
+/* erl_bif_binary.c */
+void erts_init_bif_binary(void);
+Sint erts_binary_set_loop_limit(Sint limit);
+
/* erl_unicode.c */
void erts_init_unicode(void);
Sint erts_unicode_set_loop_limit(Sint limit);
@@ -1705,6 +1711,8 @@ Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live);
Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live);
Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live);
Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live);
+Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live);
+Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live);
Uint erts_current_reductions(Process* current, Process *p);
@@ -1714,7 +1722,6 @@ int erts_print_system_version(int to, void *arg, Process *c_p);
* Interface to erl_init
*/
void erl_init(void);
-void erts_first_process(Eterm modname, void* code, unsigned size, int argc, char** argv);
#define seq_trace_output(token, msg, type, receiver, process) \
seq_trace_output_generic((token), (msg), (type), (receiver), (process), NIL)
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 10f1082039..68625801cf 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -280,10 +280,36 @@ erts_test_next_port(int set, Uint next)
return res;
}
+
+static void port_cleanup(Port *prt);
+
+#ifdef ERTS_SMP
+
+static void
+sched_port_cleanup(void *vprt)
+{
+ Port *prt = (Port *) vprt;
+ erts_smp_mtx_lock(prt->lock);
+ port_cleanup(prt);
+}
+
+#endif
+
void
erts_port_cleanup(Port *prt)
{
#ifdef ERTS_SMP
+ if (erts_smp_mtx_trylock(prt->lock) == EBUSY)
+ erts_schedule_misc_op(sched_port_cleanup, (void *) prt);
+ else
+#endif
+ port_cleanup(prt);
+}
+
+void
+port_cleanup(Port *prt)
+{
+#ifdef ERTS_SMP
Uint32 port_specific;
erts_smp_mtx_t *mtx;
#endif
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 9e8ac74f40..42c84989c6 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -60,12 +60,18 @@ func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler
func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler
# The undocumented and unsupported guard BIF is_constant/1 was removed
-# in R13. The is_constant/2 operation is marked as obosolete in genop.tab,
+# in R13. The is_constant/2 operation is marked as obsolete in genop.tab,
# so the loader will automatically generate a too_old_compiler message
# it is used, but we need to handle the is_constant/1 BIF specially here.
bif1 Fail u$func:erlang:is_constant/1 Src Dst => too_old_compiler
+# Since the constant pool was introduced in R12B, empty tuples ({})
+# are literals. Therefore we no longer need to allow put_tuple/2
+# with a tuple size of zero.
+
+put_tuple u==0 d => too_old_compiler
+
#
# All the other instructions.
#
@@ -328,11 +334,8 @@ i_is_eq_immed f y c
# Putting things.
#
-put_tuple u==0 Dst => i_put_tuple_only u Dst
put_tuple Arity Dst | put V => i_put_tuple Arity V Dst
-i_put_tuple_only A d
-
%macro: i_put_tuple PutTuple -pack
i_put_tuple A x x
i_put_tuple A y x
@@ -1177,12 +1180,6 @@ i_bs_init_bits_fail_heap I j I d
i_bs_init_bits I I d
i_bs_init_bits_heap I I I d
-bs_bits_to_bytes Fail Src Dst => i_bs_bits_to_bytes Src Fail Dst
-
-i_bs_bits_to_bytes r j d
-i_bs_bits_to_bytes x j d
-i_bs_bits_to_bytes y j d
-
bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D
bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D
@@ -1390,34 +1387,60 @@ 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_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \
- gen_guard_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \
- gen_guard_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \
- gen_guard_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \
- gen_guard_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \
- gen_guard_bif(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_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \
- gen_guard_bif(Fail, I, Bif, Src, Dst)
+ gen_guard_bif1(Fail, I, Bif, Src, Dst)
+
+gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \
+ 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 => \
+ 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
i_gc_bif1 j I s I d
+ii_gc_bif2/6
+
+ii_gc_bif2 Fail Bif S1 S2 Live D => i_fetch S1 S2 | i_gc_bif2 Fail Bif Live D
+
+i_gc_bif2 j I I d
+
+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
#
# R13B03
#
on_load
+
+#
+# R14A.
+#
+recv_mark f
+
+recv_set Fail | label Lbl | loop_rec Lf Reg => \
+ i_recv_set | label Lbl | loop_rec Lf Reg
+i_recv_set
diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c
index 964c10a380..900ebcbbf7 100644
--- a/erts/emulator/beam/register.c
+++ b/erts/emulator/beam/register.c
@@ -476,8 +476,9 @@ int erts_unregister_name(Process *c_p,
* on c_prt.
*/
- if (!c_p)
+ if (!c_p) {
c_p_locks = 0;
+ }
current_c_p_locks = c_p_locks;
restart:
@@ -489,9 +490,15 @@ int erts_unregister_name(Process *c_p,
if (is_non_value(name)) {
/* Unregister current process name */
ASSERT(c_p);
- if (c_p->reg)
+#ifdef ERTS_SMP
+ if (current_c_p_locks != c_p_locks) {
+ erts_smp_proc_lock(c_p, c_p_locks);
+ current_c_p_locks = c_p_locks;
+ }
+#endif
+ if (c_p->reg) {
r.name = c_p->reg->name;
- else {
+ } else {
/* Name got unregistered while main lock was released */
res = 0;
goto done;
@@ -533,24 +540,25 @@ int erts_unregister_name(Process *c_p,
}
} else if (rp->p) {
- Process* p = rp->p;
+
#ifdef ERTS_SMP
erts_proc_safelock(c_p,
current_c_p_locks,
c_p_locks,
rp->p,
- 0,
+ (c_p == rp->p) ? current_c_p_locks : 0,
ERTS_PROC_LOCK_MAIN);
current_c_p_locks = c_p_locks;
#endif
- p->reg = NULL;
+ rp->p->reg = NULL;
+ if (IS_TRACED_FL(rp->p, F_TRACE_PROCS)) {
+ trace_proc(c_p, rp->p, am_unregister, r.name);
+ }
#ifdef ERTS_SMP
- if (rp->p != c_p)
+ if (rp->p != c_p) {
erts_smp_proc_unlock(rp->p, ERTS_PROC_LOCK_MAIN);
-#endif
- if (IS_TRACED_FL(p, F_TRACE_PROCS)) {
- trace_proc(c_p, p, am_unregister, r.name);
}
+#endif
}
hash_erase(&process_reg, (void*) &r);
res = 1;
@@ -560,14 +568,17 @@ int erts_unregister_name(Process *c_p,
reg_write_unlock();
if (c_prt != port) {
- if (port)
+ if (port) {
erts_smp_port_unlock(port);
- if (c_prt)
+ }
+ if (c_prt) {
erts_smp_port_lock(c_prt);
+ }
}
#ifdef ERTS_SMP
- if (c_p && !current_c_p_locks)
+ if (c_p && !current_c_p_locks) {
erts_smp_proc_lock(c_p, c_p_locks);
+ }
#endif
return res;
}
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index a1955235b7..ca87d3d70f 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -648,7 +648,7 @@ extern char *erts_sys_ddll_error(int code);
/*
- * System interfaces for startup/sae code (functions found in respective sys.c)
+ * System interfaces for startup.
*/
@@ -1173,14 +1173,14 @@ EXTERN_FUNCTION(void*, sys_calloc2, (Uint, Uint));
/* Standard set of integer macros .. */
-#define get_int64(s) ((((unsigned char*) (s))[0] << 56) | \
- (((unsigned char*) (s))[1] << 48) | \
- (((unsigned char*) (s))[2] << 40) | \
- (((unsigned char*) (s))[3] << 32) | \
- (((unsigned char*) (s))[4] << 24) | \
- (((unsigned char*) (s))[5] << 16) | \
- (((unsigned char*) (s))[6] << 8) | \
- (((unsigned char*) (s))[7]))
+#define get_int64(s) (((Uint64)(((unsigned char*) (s))[0]) << 56) | \
+ (((Uint64)((unsigned char*) (s))[1]) << 48) | \
+ (((Uint64)((unsigned char*) (s))[2]) << 40) | \
+ (((Uint64)((unsigned char*) (s))[3]) << 32) | \
+ (((Uint64)((unsigned char*) (s))[4]) << 24) | \
+ (((Uint64)((unsigned char*) (s))[5]) << 16) | \
+ (((Uint64)((unsigned char*) (s))[6]) << 8) | \
+ (((Uint64)((unsigned char*) (s))[7])))
#define put_int64(i, s) do {((char*)(s))[0] = (char)((Sint64)(i) >> 56) & 0xff;\
((char*)(s))[1] = (char)((Sint64)(i) >> 48) & 0xff;\
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 51c12a0b69..445a8eebd9 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -32,6 +32,7 @@
#include "erl_binary.h"
#include "erl_bits.h"
#include "packet_parser.h"
+#include "erl_gc.h"
#define ERTS_WANT_DB_INTERNAL__
#include "erl_db.h"
#include "erl_threads.h"
@@ -125,7 +126,7 @@ erts_heap_alloc(Process* p, Uint need)
n = need;
bp = MBUF(p);
- if (bp != NULL && need <= (bp->size - bp->used_size)) {
+ if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) {
Eterm* ret = bp->mem + bp->used_size;
bp->used_size += need;
return ret;
@@ -158,7 +159,7 @@ erts_heap_alloc(Process* p, Uint need)
bp->next = MBUF(p);
MBUF(p) = bp;
- bp->size = n;
+ bp->alloc_size = n;
bp->used_size = n;
MBUF_SIZE(p) += n;
bp->off_heap.mso = NULL;
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index d2b916000e..60ae4cb108 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -53,6 +53,8 @@
#define FILE_IPREAD 27
#define FILE_ALTNAME 28
#define FILE_READ_LINE 29
+#define FILE_FDATASYNC 30
+#define FILE_FADVISE 31
/* Return codes */
@@ -357,6 +359,11 @@ struct t_data
struct t_readdir_buf *first_buf;
struct t_readdir_buf *last_buf;
} read_dir;
+ struct {
+ Sint64 offset;
+ Sint64 length;
+ int advise;
+ } fadvise;
} c;
char b[1];
};
@@ -883,6 +890,15 @@ static void invoke_chdir(void *data)
invoke_name(data, efile_chdir);
}
+static void invoke_fdatasync(void *data)
+{
+ struct t_data *d = (struct t_data *) data;
+ int fd = (int) d->fd;
+
+ d->again = 0;
+ d->result_ok = efile_fdatasync(&d->errInfo, fd);
+}
+
static void invoke_fsync(void *data)
{
struct t_data *d = (struct t_data *) data;
@@ -1637,6 +1653,18 @@ static void invoke_open(void *data)
d->result_ok = status;
}
+static void invoke_fadvise(void *data)
+{
+ struct t_data *d = (struct t_data *) data;
+ int fd = (int) d->fd;
+ off_t offset = (off_t) d->c.fadvise.offset;
+ off_t length = (off_t) d->c.fadvise.length;
+ int advise = (int) d->c.fadvise.advise;
+
+ d->again = 0;
+ d->result_ok = efile_fadvise(&d->errInfo, fd, offset, length, advise);
+}
+
static void free_readdir(void *data)
{
struct t_data *d = (struct t_data *) data;
@@ -1919,12 +1947,14 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
case FILE_RMDIR:
case FILE_CHDIR:
case FILE_DELETE:
+ case FILE_FDATASYNC:
case FILE_FSYNC:
case FILE_TRUNCATE:
case FILE_LINK:
case FILE_SYMLINK:
case FILE_RENAME:
case FILE_WRITE_INFO:
+ case FILE_FADVISE:
reply(desc, d->result_ok, &d->errInfo);
free_data(data);
break;
@@ -2209,6 +2239,18 @@ file_output(ErlDrvData e, char* buf, int count)
goto done;
}
+ case FILE_FDATASYNC:
+ {
+ d = EF_SAFE_ALLOC(sizeof(struct t_data));
+
+ d->fd = fd;
+ d->command = command;
+ d->invoke = invoke_fdatasync;
+ d->free = free_data;
+ d->level = 2;
+ goto done;
+ }
+
case FILE_FSYNC:
{
d = EF_SAFE_ALLOC(sizeof(struct t_data));
@@ -2332,6 +2374,21 @@ file_output(ErlDrvData e, char* buf, int count)
goto done;
}
+ case FILE_FADVISE:
+ {
+ d = EF_SAFE_ALLOC(sizeof(struct t_data));
+
+ d->fd = fd;
+ d->command = command;
+ d->invoke = invoke_fadvise;
+ d->free = free_data;
+ d->level = 2;
+ d->c.fadvise.offset = get_int64((uchar*) buf);
+ d->c.fadvise.length = get_int64(((uchar*) buf) + sizeof(Sint64));
+ d->c.fadvise.advise = get_int32(((uchar*) buf) + 2 * sizeof(Sint64));
+ goto done;
+ }
+
}
/*
diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h
index 9aa941e550..bbc973d58b 100644
--- a/erts/emulator/drivers/common/erl_efile.h
+++ b/erts/emulator/drivers/common/erl_efile.h
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1997-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
* 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%
*/
/*
@@ -126,6 +126,7 @@ int efile_readdir(Efile_error* errInfo, char* name,
int efile_openfile(Efile_error* errInfo, char* name, int flags,
int* pfd, Sint64* pSize);
void efile_closefile(int fd);
+int efile_fdatasync(Efile_error* errInfo, int fd);
int efile_fsync(Efile_error* errInfo, int fd);
int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
char *name, int info_for_link);
@@ -150,3 +151,5 @@ int efile_altname(Efile_error* errInfo, char *name,
int efile_link(Efile_error* errInfo, char* old, char* new);
int efile_symlink(Efile_error* errInfo, char* old, char* new);
int efile_may_openfile(Efile_error* errInfo, char *name);
+int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length,
+ int advise);
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index e8456cc616..87691fc1bc 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -55,6 +55,21 @@
#include "erl_driver.h"
+/* The IS_SOCKET_ERROR macro below is used for portability reasons. While
+ POSIX specifies that errors from socket-related system calls should be
+ indicated with a -1 return value, some users have experienced non-Windows
+ OS kernels that return negative values other than -1. While one can argue
+ that such kernels are technically broken, comparing against values less
+ than 0 covers their out-of-spec return values without imposing incorrect
+ semantics on systems that manage to correctly return -1 for errors, thus
+ increasing Erlang's portability.
+*/
+#ifdef __WIN32__
+#define IS_SOCKET_ERROR(val) ((val) == SOCKET_ERROR)
+#else
+#define IS_SOCKET_ERROR(val) ((val) < 0)
+#endif
+
#ifdef __WIN32__
#define STRNCASECMP strncasecmp
@@ -279,7 +294,7 @@ static int (*p_sctp_bindx)(int sd, struct sockaddr *addrs,
#define DEBUGF(X) printf X
#endif
-#if !defined(__WIN32__) && !defined(HAVE_STRNCASECMP)
+#if !defined(HAVE_STRNCASECMP)
#define STRNCASECMP my_strncasecmp
static int my_strncasecmp(const char *s1, const char *s2, size_t n)
@@ -299,6 +314,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define INVALID_SOCKET -1
#define INVALID_EVENT -1
#define SOCKET_ERROR -1
+
#define SOCKET int
#define HANDLE long int
#define FD_READ ERL_DRV_READ
@@ -3684,7 +3700,7 @@ static int inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
unsigned int sz = sizeof(name);
/* check that it is a socket and that the socket is bound */
- if (sock_name(s, (struct sockaddr*) &name, &sz) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_name(s, (struct sockaddr*) &name, &sz)))
return ctl_error(sock_errno(), rbuf, rsize);
desc->s = s;
if ((desc->event = sock_create_event(desc)) == INVALID_EVENT)
@@ -3696,7 +3712,7 @@ static int inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
desc->state = INET_STATE_BOUND; /* assume bound */
if (type == SOCK_STREAM) { /* check if connected */
sz = sizeof(name);
- if (sock_peer(s, (struct sockaddr*) &name, &sz) != SOCKET_ERROR)
+ if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz)))
desc->state = INET_STATE_CONNECTED;
}
@@ -5627,8 +5643,8 @@ static int inet_fill_opts(inet_descriptor* desc,
buf += arg_sz;
len -= arg_sz;
}
- if (sock_getopt(desc->s,proto,type,arg_ptr,&arg_sz) ==
- SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(sock_getopt(desc->s,proto,type,
+ arg_ptr,&arg_sz))) {
TRUNCATE_TO(0,ptr);
continue;
}
@@ -5645,7 +5661,7 @@ static int inet_fill_opts(inet_descriptor* desc,
RETURN_ERROR();
}
/* We have 5 bytes allocated to ptr */
- if (sock_getopt(desc->s,proto,type,arg_ptr,&arg_sz) == SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(sock_getopt(desc->s,proto,type,arg_ptr,&arg_sz))) {
TRUNCATE_TO(0,ptr);
continue;
}
@@ -6711,7 +6727,7 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len,
if (len != 0)
return ctl_error(EINVAL, rbuf, rsize);
- if (sock_hostname(tbuf, MAXHOSTNAMELEN) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_hostname(tbuf, MAXHOSTNAMELEN)))
return ctl_error(sock_errno(), rbuf, rsize);
return ctl_reply(INET_REP_OK, tbuf, strlen(tbuf), rbuf, rsize);
}
@@ -6728,7 +6744,7 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len,
return ctl_error(ENOTCONN, rbuf, rsize);
if ((ptr = desc->peer_ptr) == NULL) {
ptr = &peer;
- if (sock_peer(desc->s, (struct sockaddr*)ptr,&sz) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_peer(desc->s, (struct sockaddr*)ptr,&sz)))
return ctl_error(sock_errno(), rbuf, rsize);
}
if (inet_get_address(desc->sfamily, tbuf, ptr, &sz) < 0)
@@ -6765,7 +6781,7 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len,
if ((ptr = desc->name_ptr) == NULL) {
ptr = &name;
- if (sock_name(desc->s, (struct sockaddr*)ptr, &sz) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_name(desc->s, (struct sockaddr*)ptr, &sz)))
return ctl_error(sock_errno(), rbuf, rsize);
}
if (inet_get_address(desc->sfamily, tbuf, ptr, &sz) < 0)
@@ -6804,7 +6820,7 @@ static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len,
if (inet_set_address(desc->sfamily, &local, buf, &len) == NULL)
return ctl_error(EINVAL, rbuf, rsize);
- if (sock_bind(desc->s,(struct sockaddr*) &local, len) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_bind(desc->s,(struct sockaddr*) &local, len)))
return ctl_error(sock_errno(), rbuf, rsize);
desc->state = INET_STATE_BOUND;
@@ -7237,7 +7253,7 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
if (len != 2)
return ctl_error(EINVAL, rbuf, rsize);
backlog = get_int16(buf);
- if (sock_listen(desc->inet.s, backlog) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_listen(desc->inet.s, backlog)))
return ctl_error(sock_errno(), rbuf, rsize);
desc->inet.state = TCP_STATE_LISTEN;
return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize);
@@ -7271,7 +7287,7 @@ static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
code = sock_connect(desc->inet.s,
(struct sockaddr*) &desc->inet.remote, len);
- if ((code == SOCKET_ERROR) &&
+ if (IS_SOCKET_ERROR(code) &&
((sock_errno() == ERRNO_BLOCK) || /* Winsock2 */
(sock_errno() == EINPROGRESS))) { /* Unix & OSE!! */
sock_select(INETP(desc), FD_CONNECT, 1);
@@ -7947,7 +7963,7 @@ static int tcp_recv(tcp_descriptor* desc, int request_len)
n = sock_recv(desc->inet.s, desc->i_ptr, nread, 0);
- if (n == SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(n)) {
int err = sock_errno();
if (err == ECONNRESET) {
DEBUGF((" => detected close (connreset)\r\n"));
@@ -8449,8 +8465,8 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev)
(long)desc->inet.port, desc->inet.s, h_len, len));
if (desc->tcp_add_flags & TCP_ADDF_DELAY_SEND) {
n = 0;
- } else if (sock_sendv(desc->inet.s, ev->iov, vsize, &n, 0)
- == SOCKET_ERROR) {
+ } else if (IS_SOCKET_ERROR(sock_sendv(desc->inet.s, ev->iov,
+ vsize, &n, 0))) {
if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) {
int err = sock_errno();
DEBUGF(("tcp_sendv(%ld): s=%d, "
@@ -8543,7 +8559,7 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, int len)
if (desc->tcp_add_flags & TCP_ADDF_DELAY_SEND) {
sock_send(desc->inet.s, buf, 0, 0);
n = 0;
- } else if (sock_sendv(desc->inet.s,iov,2,&n,0) == SOCKET_ERROR) {
+ } else if (IS_SOCKET_ERROR(sock_sendv(desc->inet.s,iov,2,&n,0))) {
if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) {
int err = sock_errno();
DEBUGF(("tcp_send(%ld): s=%d,sock_sendv(size=2) errno = %d\r\n",
@@ -8616,7 +8632,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
int code = sock_peer(desc->inet.s,
(struct sockaddr*) &desc->inet.remote, &sz);
- if (code == SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(code)) {
desc->inet.state = TCP_STATE_BOUND; /* restore state */
ret = async_error(INETP(desc), sock_errno());
goto done;
@@ -8657,7 +8673,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
DEBUGF(("tcp_inet_output(%ld): s=%d, About to send %d items\r\n",
(long)desc->inet.port, desc->inet.s, vsize));
- if (sock_sendv(desc->inet.s, iov, vsize, &n, 0)==SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(sock_sendv(desc->inet.s, iov, vsize, &n, 0))) {
if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) {
DEBUGF(("tcp_inet_output(%ld): sock_sendv(%d) errno = %d\r\n",
(long)desc->inet.port, vsize, sock_errno()));
@@ -8926,7 +8942,7 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
sock_select(desc, FD_CONNECT, 1);
code = sock_connect(desc->s, &remote.sa, len);
- if ((code == SOCKET_ERROR) && (sock_errno() == EINPROGRESS)) {
+ if (IS_SOCKET_ERROR(code) && (sock_errno() == EINPROGRESS)) {
/* XXX: Unix only -- WinSock would have a different cond! */
desc->state = SCTP_STATE_CONNECTING;
if (timeout != INET_INFINITY)
@@ -8966,7 +8982,7 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
code = sock_connect(desc->s,
(struct sockaddr*) &desc->remote, len);
- if (code == SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(code)) {
sock_connect(desc->s, (struct sockaddr*) NULL, 0);
desc->state &= ~INET_F_ACTIVE;
return ctl_error(sock_errno(), rbuf, rsize);
@@ -9000,7 +9016,7 @@ static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len,
return ctl_error(EINVAL, rbuf, rsize);
flag = get_int8(buf);
- if (sock_listen(desc->s, flag) == SOCKET_ERROR)
+ if (IS_SOCKET_ERROR(sock_listen(desc->s, flag)))
return ctl_error(sock_errno(), rbuf, rsize);
desc->state = SCTP_STATE_LISTEN; /* XXX: not used? */
@@ -9205,7 +9221,7 @@ static void packet_inet_command(ErlDrvData e, char* buf, int len)
check_result_code:
/* "code" analysis is the same for both SCTP and UDP cases above: */
#endif
- if (code == SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(code)) {
int err = sock_errno();
inet_reply_error(desc, err);
}
@@ -9304,7 +9320,7 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
check_result:
#endif
/* Analyse the result: */
- if (n == SOCKET_ERROR
+ 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
@@ -9419,7 +9435,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event)
int code = sock_peer(desc->s,
(struct sockaddr*) &desc->remote, &sz);
- if (code == SOCKET_ERROR) {
+ if (IS_SOCKET_ERROR(code)) {
desc->state = PACKET_STATE_BOUND; /* restore state */
ret = async_error(desc, sock_errno());
goto done;
@@ -9860,23 +9876,26 @@ int erts_sock_connect(erts_sock_t socket, byte *ip_addr, int len, Uint16 port)
if (!inet_set_address(AF_INET, &addr, buf, &blen))
return 0;
- if (SOCKET_ERROR == sock_connect(s,
+ if (IS_SOCKET_ERROR(sock_connect(s,
(struct sockaddr *) &addr,
- sizeof(struct sockaddr_in)))
+ sizeof(struct sockaddr_in))))
return 0;
return 1;
}
Sint erts_sock_send(erts_sock_t socket, const void *buf, Sint len)
{
- return (Sint) sock_send((SOCKET) socket, buf, (size_t) len, 0);
+ Sint result = (Sint) sock_send((SOCKET) socket, buf, (size_t) len, 0);
+ if (IS_SOCKET_ERROR(result))
+ return SOCKET_ERROR;
+ return result;
}
int erts_sock_gethostname(char *buf, int bufsz)
{
- if (sock_hostname(buf, bufsz) == SOCKET_ERROR)
- return -1;
+ if (IS_SOCKET_ERROR(sock_hostname(buf, bufsz)))
+ return SOCKET_ERROR;
return 0;
}
diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c
index 4a39a156e6..abedcc933a 100644
--- a/erts/emulator/drivers/common/ram_file_drv.c
+++ b/erts/emulator/drivers/common/ram_file_drv.c
@@ -35,6 +35,7 @@
#define RAM_FILE_TRUNCATE 14
#define RAM_FILE_PREAD 17
#define RAM_FILE_PWRITE 18
+#define RAM_FILE_FDATASYNC 19
/* other operations */
#define RAM_FILE_GET 30
@@ -45,6 +46,8 @@
#define RAM_FILE_UUENCODE 35 /* uuencode file */
#define RAM_FILE_UUDECODE 36 /* uudecode file */
#define RAM_FILE_SIZE 37 /* get file size */
+#define RAM_FILE_ADVISE 38 /* predeclare the access
+ * pattern for file data */
/* possible new operations include:
DES_ENCRYPT
DES_DECRYPT
@@ -558,6 +561,13 @@ static void rfile_command(ErlDrvData e, char* buf, int count)
numeric_reply(f, 0); /* 0 is not used */
break;
+ case RAM_FILE_FDATASYNC:
+ if (f->flags == 0)
+ error_reply(f, EBADF);
+ else
+ reply(f, 1, 0);
+ break;
+
case RAM_FILE_FSYNC:
if (f->flags == 0)
error_reply(f, EBADF);
@@ -685,6 +695,13 @@ static void rfile_command(ErlDrvData e, char* buf, int count)
case RAM_FILE_UUDECODE: /* uudecode file */
ram_file_uudecode(f);
break;
+
+ case RAM_FILE_ADVISE:
+ if (f->flags == 0)
+ error_reply(f, EBADF);
+ else
+ reply(f, 1, 0);
+ break;
}
/*
* Ignore anything else -- let the caller hang.
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index 1d094ee613..ea016526ef 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -774,6 +774,17 @@ efile_closefile(int fd)
}
int
+efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */
+ int fd) /* File descriptor for file to sync data. */
+{
+#ifdef HAVE_FDATASYNC
+ return check_error(fdatasync(fd), errInfo);
+#else
+ return efile_fsync(errInfo, fd);
+#endif
+}
+
+int
efile_fsync(Efile_error *errInfo, /* Where to return error codes. */
int fd) /* File descriptor for file to sync. */
{
@@ -1437,3 +1448,14 @@ efile_symlink(Efile_error* errInfo, char* old, char* new)
return check_error(symlink(old, new), errInfo);
#endif
}
+
+int
+efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
+ Sint64 length, int advise)
+{
+#ifdef HAVE_POSIX_FADVISE
+ return check_error(posix_fadvise(fd, offset, length, advise), errInfo);
+#else
+ return check_error(0, errInfo);
+#endif
+}
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
index 89aaad31da..24b6fb30dc 100644
--- a/erts/emulator/drivers/win32/win_efile.c
+++ b/erts/emulator/drivers/win32/win_efile.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 1997-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
* 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%
*/
/*
@@ -689,7 +689,8 @@ Sint64* pSize; /* Where to store the size of the file. */
if (flags & EFILE_MODE_APPEND) {
crFlags = OPEN_ALWAYS;
}
- fd = CreateFile(name, access, FILE_SHARE_READ | FILE_SHARE_WRITE,
+ fd = CreateFile(name, access,
+ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL, crFlags, FILE_ATTRIBUTE_NORMAL, NULL);
/*
@@ -764,6 +765,15 @@ int fd; /* File descriptor for file to close. */
}
int
+efile_fdatasync(errInfo, fd)
+Efile_error* errInfo; /* Where to return error codes. */
+int fd; /* File descriptor for file to sync. */
+{
+ /* Not available in Windows, just call regular fsync */
+ return efile_fsync(errInfo, fd);
+}
+
+int
efile_fsync(errInfo, fd)
Efile_error* errInfo; /* Where to return error codes. */
int fd; /* File descriptor for file to sync. */
@@ -1424,3 +1434,12 @@ efile_symlink(Efile_error* errInfo, char* old, char* new)
errno = ENOTSUP;
return check_error(-1, errInfo);
}
+
+int
+efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
+ Sint64 length, int advise)
+{
+ /* posix_fadvise is not available on Windows, do nothing */
+ errno = ERROR_SUCCESS;
+ return check_error(0, errInfo);
+}
diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c
index e57e293547..6c9e1d9ba7 100644
--- a/erts/emulator/hipe/hipe_gc.c
+++ b/erts/emulator/hipe/hipe_gc.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 2004-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 2004-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
* 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%
*/
/* $Id$
@@ -86,7 +86,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
if (is_boxed(gval)) {
Eterm *ptr = boxed_val(gval);
Eterm val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*nsp_i = val;
} else if (in_area(ptr, src, src_size) ||
@@ -96,7 +96,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
Eterm val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
} else if (in_area(ptr, src, src_size) ||
in_area(ptr, oh, oh_size)) {
@@ -193,7 +193,7 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
if (is_boxed(gval)) {
Eterm *ptr = boxed_val(gval);
Eterm val = *ptr;
- if (IS_MOVED(val)) {
+ if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*nsp_i = val;
} else if (in_area(ptr, heap, mature_size)) {
@@ -205,7 +205,7 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
} else if (is_list(gval)) {
Eterm *ptr = list_val(gval);
Eterm val = *ptr;
- if (is_non_value(val)) {
+ if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
} else if (in_area(ptr, heap, mature_size)) {
MOVE_CONS(ptr, val, old_htop, nsp_i);
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 5cca33d7eb..09fb6337f7 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -130,13 +130,18 @@
#define ERTS_POLLSET_IS_POLLED(PS) \
((int) erts_smp_atomic_read(&(PS)->polled))
-#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) \
- ((int) erts_smp_atomic_xchg(&(PS)->woken, (long) 1))
-#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \
- erts_smp_atomic_set(&(PS)->woken, (long) 1)
-#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \
- erts_smp_atomic_set(&(PS)->woken, (long) 0)
-#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \
+#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) set_poller_woken_chk((PS))
+#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \
+do { \
+ ERTS_THR_MEMORY_BARRIER; \
+ erts_smp_atomic_set(&(PS)->woken, (long) 1); \
+} while (0)
+#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \
+do { \
+ erts_smp_atomic_set(&(PS)->woken, (long) 0); \
+ ERTS_THR_MEMORY_BARRIER; \
+} while (0)
+#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \
((int) erts_smp_atomic_read(&(PS)->woken))
#else
@@ -194,13 +199,18 @@
#else
-#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) \
- ((int) erts_smp_atomic_xchg(&(PS)->interrupt, (long) 0))
-#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \
- erts_smp_atomic_set(&(PS)->interrupt, (long) 0)
-#define ERTS_POLLSET_SET_INTERRUPTED(PS) \
- erts_smp_atomic_set(&(PS)->interrupt, (long) 1)
-#define ERTS_POLLSET_IS_INTERRUPTED(PS) \
+#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS))
+#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \
+do { \
+ erts_smp_atomic_set(&(PS)->interrupt, (long) 0); \
+ ERTS_THR_MEMORY_BARRIER; \
+} while (0)
+#define ERTS_POLLSET_SET_INTERRUPTED(PS) \
+do { \
+ ERTS_THR_MEMORY_BARRIER; \
+ erts_smp_atomic_set(&(PS)->interrupt, (long) 1); \
+} while (0)
+#define ERTS_POLLSET_IS_INTERRUPTED(PS) \
((int) erts_smp_atomic_read(&(PS)->interrupt))
#endif
@@ -336,16 +346,30 @@ struct ErtsPollSet_ {
#endif
};
-#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP)
-
static ERTS_INLINE int
unset_interrupted_chk(ErtsPollSet ps)
{
+ int res;
+#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP)
/* This operation isn't atomic, but we have no need at all for an
atomic operation here... */
- int res = ps->interrupt;
+ res = ps->interrupt;
ps->interrupt = 0;
+#else
+ res = (int) erts_smp_atomic_xchg(&ps->interrupt, (long) 0);
+ ERTS_THR_MEMORY_BARRIER;
+#endif
return res;
+
+}
+
+#ifdef ERTS_SMP
+
+static ERTS_INLINE int
+set_poller_woken_chk(ErtsPollSet ps)
+{
+ ERTS_THR_MEMORY_BARRIER;
+ return (int) erts_smp_atomic_xchg(&ps->woken, (long) 1);
}
#endif
@@ -2405,6 +2429,7 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
while (urqbp) {
size += sizeof(ErtsPollSetUpdateRequestsBlock);
pending_updates += urqbp->len;
+ urqbp = urqbp->next;
}
}
#endif
diff --git a/erts/emulator/sys/unix/erl9_start.c b/erts/emulator/sys/unix/erl9_start.c
deleted file mode 100644
index 578062d7e2..0000000000
--- a/erts/emulator/sys/unix/erl9_start.c
+++ /dev/null
@@ -1,130 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2002-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%
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-
-/*
- * XXX This is a temporary dummy to make sys.c happy until we'll rewrite it.
- */
-unsigned preloaded_size_ring0 = 1;
-unsigned char preloaded_ring0[1] = {0};
-
-Preload pre_loaded[] = {
- {"ring0", 1, preloaded_ring0},
- {0, 0, 0}
-};
-
-int
-main(int argc, char** argv)
-{
- char sbuf[1024];
- struct {
- void* p;
- int sz;
- } bins[2];
- int bin_num = 0;
- FILE* fp;
- char* progname = argv[0];
- char* eq;
-
- argv++, argc--;
-
- if (argc > 0 && argv[0][0] == '-') {
- argv++, argc--;
- }
- if (argc < 1) {
- abort();
- }
- if ((fp = fopen(argv[0], "r")) == NULL) {
- abort();
- }
-
- /* Needs to be called before any memory allocation */
- erts_short_init();
-
- while (fgets(sbuf, sizeof sbuf, fp)) {
- if (sbuf[0] == '#') {
- continue; /* Comment */
- } else if (sbuf[0] == 'e' && strncmp("exec", sbuf, 4) == 0) {
- continue; /* Comment ;-) */
- } else if ((eq = strchr(sbuf, '=')) != NULL) {
- char* val;
- char* p = strchr(sbuf, '\n');
- if (p) {
- *p = '\0';
- }
- *eq = '\0';
- val = erts_read_env(sbuf);
- if (val == NULL) {
- *eq = '=';
- erts_sys_putenv(sbuf, eq - &sbuf[0]);
- }
- erts_free_read_env(val);
- } else if (sbuf[0] == ':' && '0' <= sbuf[1] && sbuf[1] <= '9') {
- int load_size = atoi(sbuf+1);
- void* bin;
-
- bin = malloc(load_size);
- if (fread(bin, 1, load_size, fp) != load_size) {
- abort();
- }
- bins[bin_num].p = bin;
- bins[bin_num].sz = load_size;
- bin_num++;
- } else if (strcmp(sbuf, "--end--\n") == 0) {
- int rval;
- Eterm mod = NIL;
- char *val;
-
- fclose(fp);
-
- if (bin_num != 2) {
- abort();
- }
-
- val = erts_read_env("ERLBREAKHANDLER");
- if (val) {
- init_break_handler();
- }
- erts_free_read_env(val);
-
- if ((rval = erts_load_module(NULL, 0, NIL, &mod, bins[0].p, bins[0].sz)) < 0) {
- fprintf(stderr, "%s: Load of initial module failed: %d\n",
- progname, rval);
- abort();
- }
- erts_first_process(mod, bins[1].p, bins[1].sz, argc, argv);
- free(bins[0].p);
- free(bins[1].p);
- process_main();
- abort();
- } else {
- fprintf(stderr, "%s: bad line: %s\n", progname, sbuf);
- abort();
- }
- }
- abort();
-}
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index d816cc2c07..a766fe9575 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -1,19 +1,19 @@
/*
* %CopyrightBegin%
- *
- * Copyright Ericsson AB 2007-2009. All Rights Reserved.
- *
+ *
+ * Copyright Ericsson AB 2007-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
* 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%
*/
#ifdef HAVE_CONFIG_H
@@ -304,24 +304,51 @@ struct ErtsPollSet_ {
erts_smp_atomic_set(&(PS)->polled, (long) 0)
#define ERTS_POLLSET_IS_POLLED(PS) \
((int) erts_smp_atomic_read(&(PS)->polled))
-#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) \
- ((int) erts_smp_atomic_xchg(&(PS)->woken, (long) 1))
-#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \
- erts_smp_atomic_set(&(PS)->woken, (long) 1)
-#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \
- erts_smp_atomic_set(&(PS)->woken, (long) 0)
-#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \
+
+#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) set_poller_woken_chk((PS))
+#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \
+do { \
+ ERTS_THR_MEMORY_BARRIER; \
+ erts_smp_atomic_set(&(PS)->woken, (long) 1); \
+} while (0)
+#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \
+do { \
+ erts_smp_atomic_set(&(PS)->woken, (long) 0); \
+ ERTS_THR_MEMORY_BARRIER; \
+} while (0)
+#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \
((int) erts_smp_atomic_read(&(PS)->woken))
-#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) \
- ((int) erts_smp_atomic_xchg(&(PS)->interrupt, (long) 0))
-#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \
- erts_smp_atomic_set(&(PS)->interrupt, (long) 0)
-#define ERTS_POLLSET_SET_INTERRUPTED(PS) \
- erts_smp_atomic_set(&(PS)->interrupt, (long) 1)
-#define ERTS_POLLSET_IS_INTERRUPTED(PS) \
+#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS))
+#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \
+do { \
+ erts_smp_atomic_set(&(PS)->interrupt, (long) 0); \
+ ERTS_THR_MEMORY_BARRIER; \
+} while (0)
+#define ERTS_POLLSET_SET_INTERRUPTED(PS) \
+do { \
+ ERTS_THR_MEMORY_BARRIER; \
+ erts_smp_atomic_set(&(PS)->interrupt, (long) 1); \
+} while (0)
+#define ERTS_POLLSET_IS_INTERRUPTED(PS) \
((int) erts_smp_atomic_read(&(PS)->interrupt))
+static ERTS_INLINE int
+unset_interrupted_chk(ErtsPollSet ps)
+{
+ int res = (int) erts_smp_atomic_xchg(&ps->interrupt, (long) 0);
+ ERTS_THR_MEMORY_BARRIER;
+ return res;
+
+}
+
+static ERTS_INLINE int
+set_poller_woken_chk(ErtsPollSet ps)
+{
+ ERTS_THR_MEMORY_BARRIER;
+ return (int) erts_smp_atomic_xchg(&ps->woken, (long) 1);
+}
+
#else
#define ERTS_POLLSET_LOCK(PS)
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 46dee826f0..d3921a14f8 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -33,6 +33,7 @@
#include "../../drivers/win32/win_con.h"
+
void erts_sys_init_float(void);
void erl_start(int, char**);
@@ -95,6 +96,10 @@ static erts_smp_mtx_t sys_driver_data_lock;
static FUNCTION(int, driver_write, (long, HANDLE, byte*, int));
static void common_stop(int);
static int create_file_thread(struct async_io* aio, int mode);
+#ifdef ERTS_SMP
+static void close_active_handles(ErlDrvPort, const HANDLE* handles, int cnt);
+static DWORD WINAPI threaded_handle_closer(LPVOID param);
+#endif
static DWORD WINAPI threaded_reader(LPVOID param);
static DWORD WINAPI threaded_writer(LPVOID param);
static DWORD WINAPI threaded_exiter(LPVOID param);
@@ -132,6 +137,9 @@ static BOOL win_console = FALSE;
static OSVERSIONINFO int_os_version; /* Version information for Win32. */
+#ifdef ERTS_SMP
+static BOOL (WINAPI *fpCancelIoEx)(HANDLE,LPOVERLAPPED);
+#endif
/* This is the system's main function (which may or may not be called "main")
- do general system-dependent initialization
@@ -676,25 +684,50 @@ release_driver_data(DriverData* dp)
erts_smp_mtx_lock(&sys_driver_data_lock);
#ifdef ERTS_SMP
- /* This is a workaround for the fact that CancelIo cant cancel
- requests issued by another thread and that we still cant use
- CancelIoEx as that's only availabele in Vista etc. */
- if(dp->in.async_io_active && dp->in.fd != INVALID_HANDLE_VALUE) {
- CloseHandle(dp->in.fd);
- dp->in.fd = INVALID_HANDLE_VALUE;
- DEBUGF(("Waiting for the in event thingie"));
- WaitForSingleObject(dp->in.ov.hEvent,INFINITE);
- DEBUGF(("...done\n"));
- }
- if(dp->out.async_io_active && dp->out.fd != INVALID_HANDLE_VALUE) {
- CloseHandle(dp->out.fd);
- dp->out.fd = INVALID_HANDLE_VALUE;
- DEBUGF(("Waiting for the out event thingie"));
- WaitForSingleObject(dp->out.ov.hEvent,INFINITE);
- DEBUGF(("...done\n"));
+ if (fpCancelIoEx != NULL) {
+ if (dp->in.thread == (HANDLE) -1 && dp->in.fd != INVALID_HANDLE_VALUE) {
+ (*fpCancelIoEx)(dp->in.fd, NULL);
+ }
+ if (dp->out.thread == (HANDLE) -1 && dp->out.fd != INVALID_HANDLE_VALUE) {
+ (*fpCancelIoEx)(dp->out.fd, NULL);
+ }
+ }
+ else {
+ /* This is a workaround for the fact that CancelIo cant cancel
+ requests issued by another thread and that we cant use
+ CancelIoEx as that's only availabele in Vista etc.
+ R14: Avoid scheduler deadlock by only wait for 10ms, and then spawn
+ a thread that will keep waiting in in order to close handles. */
+ HANDLE handles[2];
+ int i = 0;
+ int timeout = 10;
+ if(dp->in.async_io_active && dp->in.fd != INVALID_HANDLE_VALUE) {
+ CloseHandle(dp->in.fd);
+ dp->in.fd = INVALID_HANDLE_VALUE;
+ DEBUGF(("Waiting for the in event thingie"));
+ if (WaitForSingleObject(dp->in.ov.hEvent,timeout) == WAIT_TIMEOUT) {
+ handles[i++] = dp->in.ov.hEvent;
+ dp->in.ov.hEvent = NULL;
+ timeout = 0;
+ }
+ DEBUGF(("...done\n"));
+ }
+ if(dp->out.async_io_active && dp->out.fd != INVALID_HANDLE_VALUE) {
+ CloseHandle(dp->out.fd);
+ dp->out.fd = INVALID_HANDLE_VALUE;
+ DEBUGF(("Waiting for the out event thingie"));
+ if (WaitForSingleObject(dp->out.ov.hEvent,timeout) == WAIT_TIMEOUT) {
+ handles[i++] = dp->out.ov.hEvent;
+ dp->out.ov.hEvent = NULL;
+ }
+ DEBUGF(("...done\n"));
+ }
+ if (i > 0) {
+ close_active_handles(dp->port_num, handles, i);
+ }
}
#else
- if (dp->out.thread == (HANDLE) -1 && dp->in.fd != INVALID_HANDLE_VALUE) {
+ if (dp->in.thread == (HANDLE) -1 && dp->in.fd != INVALID_HANDLE_VALUE) {
CancelIo(dp->in.fd);
}
if (dp->out.thread == (HANDLE) -1 && dp->out.fd != INVALID_HANDLE_VALUE) {
@@ -737,6 +770,48 @@ release_driver_data(DriverData* dp)
erts_smp_mtx_unlock(&sys_driver_data_lock);
}
+#ifdef ERTS_SMP
+
+struct handles_to_be_closed
+{
+ int cnt;
+ HANDLE handles[2];
+};
+
+static void close_active_handles(ErlDrvPort port_num, const HANDLE* handles, int cnt)
+{
+ DWORD tid;
+ HANDLE thread;
+ int i;
+ struct handles_to_be_closed* htbc = erts_alloc(ERTS_ALC_T_DRV_TAB,
+ sizeof(struct handles_to_be_closed));
+ htbc->cnt = cnt;
+ for (i=0; i < cnt; ++i) {
+ htbc->handles[i] = handles[i];
+ (void) driver_select(port_num, (ErlDrvEvent)handles[i],
+ ERL_DRV_USE_NO_CALLBACK, 0);
+ }
+ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_handle_closer, htbc, 0, &tid);
+ CloseHandle(thread);
+}
+
+
+static DWORD WINAPI
+threaded_handle_closer(LPVOID param)
+{
+ struct handles_to_be_closed* htbc = (struct handles_to_be_closed*) param;
+ int i;
+ DEBUGF(("threaded_handle_closer waiting for %d handles\r\n",htbc->cnt));
+ WaitForMultipleObjects(htbc->cnt, htbc->handles, TRUE, INFINITE);
+ for (i=0; i < htbc->cnt; ++i) {
+ CloseHandle(htbc->handles[i]);
+ }
+ erts_free(ERTS_ALC_T_DRV_TAB, htbc);
+ DEBUGF(("threaded_handle_closer terminating\r\n"));
+ return 0;
+}
+#endif /* ERTS_SMP */
+
/*
* Stores input and output file descriptors in the DriverData structure,
* and calls driver_select().
@@ -1026,12 +1101,19 @@ static int
spawn_init()
{
int i;
-
+#ifdef ERTS_SMP
+ HMODULE module = GetModuleHandle("kernel32");
+ fpCancelIoEx = (module != NULL) ?
+ (BOOL (WINAPI *)(HANDLE,LPOVERLAPPED))
+ GetProcAddress(module,"CancelIoEx") : NULL;
+ DEBUGF(("fpCancelIoEx = %p\r\n", fpCancelIoEx));
+#endif
driver_data = (struct driver_data *)
erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data));
erts_smp_atomic_add(&sys_misc_mem_sz, max_files*sizeof(struct driver_data));
for (i = 0; i < max_files; i++)
driver_data[i].port_num = PORT_FREE;
+
return 0;
}
@@ -2928,12 +3010,6 @@ erts_sys_pre_init(void)
erts_sys_env_init();
}
-/*
- * the last two only used for standalone erlang
- * they should are used by sae_main in beam dll to
- * enable standalone execution via erl_api-routines
- */
-
void noinherit_std_handle(DWORD type)
{
HANDLE h = GetStdHandle(type);
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index df2faf1450..97b94c466f 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -81,6 +81,7 @@ MODULES= \
port_bif_SUITE \
process_SUITE \
pseudoknot_SUITE \
+ receive_SUITE \
ref_SUITE \
register_SUITE \
save_calls_SUITE \
@@ -117,7 +118,8 @@ NO_OPT= bs_bincomp \
bs_match_int \
bs_match_tail \
bs_match_misc \
- bs_utf
+ bs_utf \
+ guard
NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE)
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index cfbc5dfe81..15c09d9158 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2005-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
%% 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%
%%
@@ -308,6 +308,18 @@ min_max(Config) when is_list(Config) ->
?line 42.0 = erlang:min(42.0, 42),
?line 42.0 = erlang:max(42.0, 42),
+ %% And now (R14) they are also autoimported!
+ ?line a = min(id(a), a),
+ ?line a = min(id(a), b),
+ ?line a = min(id(b), a),
+ ?line b = min(id(b), b),
+ ?line a = max(id(a), a),
+ ?line b = max(id(a), b),
+ ?line b = max(id(b), a),
+ ?line b = max(id(b), b),
+
+ ?line 42.0 = min(42.0, 42),
+ ?line 42.0 = max(42.0, 42),
ok.
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 7ecc31aa29..77d2579848 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -438,11 +438,11 @@ terms(Config) when is_list(Config) ->
ok
end,
Term = binary_to_term(Bin),
- Term = erlang:binary_to_term(Bin, [safe]),
+ Term = binary_to_term(Bin, [safe]),
Unaligned = make_unaligned_sub_binary(Bin),
Term = binary_to_term(Unaligned),
- Term = erlang:binary_to_term(Unaligned, []),
- Term = erlang:binary_to_term(Bin, [safe]),
+ Term = binary_to_term(Unaligned, []),
+ Term = binary_to_term(Bin, [safe]),
BinC = erlang:term_to_binary(Term, [compressed]),
Term = binary_to_term(BinC),
true = size(BinC) =< size(Bin),
@@ -542,7 +542,7 @@ bad_bin_to_term(BadBin) ->
{'EXIT',{badarg,_}} = (catch binary_to_term(BadBin)).
bad_bin_to_term(BadBin,Opts) ->
- {'EXIT',{badarg,_}} = (catch erlang:binary_to_term(BadBin,Opts)).
+ {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin,Opts)).
safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2";
safe_binary_to_term2(Config) when is_list(Config) ->
@@ -553,7 +553,7 @@ safe_binary_to_term2(Config) when is_list(Config) ->
BadRef = <<131,114,0,3,BadHostAtom/binary,0,<<0,0,0,255>>/binary,
Empty/binary,Empty/binary>>,
?line bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom
- ?line fullsweep_after = erlang:binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
+ ?line fullsweep_after = binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
BadExtFun = <<131,113,100,0,4,98,108,117,101,100,0,4,109,111,111,110,97,3>>,
?line bad_bin_to_term(BadExtFun, [safe]),
ok.
diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl
index 9b16170293..7350aef4ec 100644
--- a/erts/emulator/test/busy_port_SUITE.erl
+++ b/erts/emulator/test/busy_port_SUITE.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-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
%% 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%
%%
@@ -182,7 +182,7 @@ system_monitor(Config) when is_list(Config) ->
?line Master ! {Owner, {command, "u"}},
?line {Busy,beta} = rec(Void),
?line Void = rec(Void),
- ?line NewMonitor = erlang:system_monitor(OldMonitor),
+ ?line _NewMonitor = erlang:system_monitor(OldMonitor),
?line OldMonitor = erlang:system_monitor(),
?line OldMonitor = erlang:system_monitor(OldMonitor),
%%
@@ -361,7 +361,6 @@ soft_busy_driver(Config) when is_list(Config) ->
hs_test(Config, false).
hs_test(Config, HardBusy) when is_list(Config) ->
- ?line Me = self(),
?line DrvName = case HardBusy of
true -> 'hard_busy_drv';
false -> 'soft_busy_drv'
@@ -479,7 +478,7 @@ hs_busy_pcmd(Prt, Opts, StartFun, EndFun) ->
Tester ! {self(), doing_port_command},
Start = os:timestamp(),
Res = try {return,
- erlang:port_command(Prt, [], Opts)}
+ port_command(Prt, [], Opts)}
catch Exception:Error -> {Exception, Error}
end,
End = os:timestamp(),
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index 8f48d8a992..7c19274696 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -1,23 +1,24 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-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
%% 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(distribution_SUITE).
+-compile(r12).
%% Tests distribution and the tcp driver.
diff --git a/erts/emulator/test/fun_r12_SUITE.erl b/erts/emulator/test/fun_r12_SUITE.erl
index f21299ba67..9262731dcb 100644
--- a/erts/emulator/test/fun_r12_SUITE.erl
+++ b/erts/emulator/test/fun_r12_SUITE.erl
@@ -18,6 +18,7 @@
%%
-module(fun_r12_SUITE).
+-compile(r12).
-export([all/1,init_per_testcase/2,fin_per_testcase/2,dist_old_release/1]).
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index 23482a20d7..8fef36dfaf 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -1,33 +1,34 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-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
%% 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(guard_SUITE).
-export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1,
- type_tests/1]).
+ type_tests/1,guard_bif_binary_part/1]).
-include("test_server.hrl").
-export([init/3]).
-import(lists, [member/2]).
-all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests].
+all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs,
+ type_tests, guard_bif_binary_part].
bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly.";
bad_arith(Config) when is_list(Config) ->
@@ -136,6 +137,170 @@ init(Fun, Args, Filler) ->
dummy(_) ->
ok.
+-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
+mask_error({'EXIT',{Err,_}}) ->
+ Err;
+mask_error(Else) ->
+ Else.
+
+guard_bif_binary_part(doc) ->
+ ["Test the binary_part/2,3 guard BIF's extensively"];
+guard_bif_binary_part(Config) when is_list(Config) ->
+ %% Overflow tests that need to be unoptimized
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ -16#7FFFFFFFFFFFFFFF-1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ 16#7FFFFFFFFFFFFFFF})),
+ F = fun(X) ->
+ Master = self(),
+ {Pid,Ref} = spawn_monitor( fun() ->
+ A = lists:duplicate(X,a),
+ B = [do_binary_part_guard() | A],
+ Master ! {self(),hd(B)},
+ ok
+ end),
+ receive
+ {Pid,ok} ->
+ erlang:demonitor(Ref,[flush]),
+ ok;
+ Error ->
+ Error
+ end
+ end,
+ [ ok = F(N) || N <- lists:seq(1,10000) ],
+ ok.
+
+
+do_binary_part_guard() ->
+ ?line 1 = bptest(<<1,2,3>>),
+ ?line 2 = bptest(<<2,1,3>>),
+ ?line error = bptest(<<1>>),
+ ?line error = bptest(<<>>),
+ ?line error = bptest(apa),
+ ?line 3 = bptest(<<2,3,3>>),
+ % With one variable (pos)
+ ?line 1 = bptest(<<1,2,3>>,1),
+ ?line 2 = bptest(<<2,1,3>>,1),
+ ?line error = bptest(<<1>>,1),
+ ?line error = bptest(<<>>,1),
+ ?line error = bptest(apa,1),
+ ?line 3 = bptest(<<2,3,3>>,1),
+ % With one variable (length)
+ ?line 1 = bptesty(<<1,2,3>>,1),
+ ?line 2 = bptesty(<<2,1,3>>,1),
+ ?line error = bptesty(<<1>>,1),
+ ?line error = bptesty(<<>>,1),
+ ?line error = bptesty(apa,1),
+ ?line 3 = bptesty(<<2,3,3>>,2),
+ % With one variable (whole tuple)
+ ?line 1 = bptestx(<<1,2,3>>,{1,1}),
+ ?line 2 = bptestx(<<2,1,3>>,{1,1}),
+ ?line error = bptestx(<<1>>,{1,1}),
+ ?line error = bptestx(<<>>,{1,1}),
+ ?line error = bptestx(apa,{1,1}),
+ ?line 3 = bptestx(<<2,3,3>>,{1,2}),
+ % With two variables
+ ?line 1 = bptest(<<1,2,3>>,1,1),
+ ?line 2 = bptest(<<2,1,3>>,1,1),
+ ?line error = bptest(<<1>>,1,1),
+ ?line error = bptest(<<>>,1,1),
+ ?line error = bptest(apa,1,1),
+ ?line 3 = bptest(<<2,3,3>>,1,2),
+ % Direct (autoimported) call, these will be evaluated by the compiler...
+ ?line <<2>> = binary_part(<<1,2,3>>,1,1),
+ ?line <<1>> = binary_part(<<2,1,3>>,1,1),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)),
+ ?line <<3,3>> = binary_part(<<2,3,3>>,1,2),
+ % Direct call through apply
+ ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
+ ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
+ ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
+ % Constant propagation
+ ?line Bin = <<1,2,3>>,
+ ?line ok = if
+ binary_part(Bin,1,1) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ?line ok = if
+ binary_part(Bin,{1,1}) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ok.
+
+
+bptest(B) when length(B) =:= 1337 ->
+ 1;
+bptest(B) when binary_part(B,{1,1}) =:= <<2>> ->
+ 1;
+bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> ->
+ 2;
+bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> ->
+ 3;
+bptest(_) ->
+ error.
+
+bptest(B,A) when length(B) =:= A ->
+ 1;
+bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> ->
+ 1;
+bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> ->
+ 2;
+bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> ->
+ 3;
+bptest(_,_) ->
+ error.
+
+bptestx(B,A) when length(B) =:= A ->
+ 1;
+bptestx(B,A) when binary_part(B,A) =:= <<2>> ->
+ 1;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> ->
+ 2;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> ->
+ 3;
+bptestx(_,_) ->
+ error.
+
+bptesty(B,A) when length(B) =:= A ->
+ 1;
+bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> ->
+ 1;
+bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> ->
+ 2;
+bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> ->
+ 3;
+bptesty(_,_) ->
+ error.
+
+bptest(B,A,_C) when length(B) =:= A ->
+ 1;
+bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> ->
+ 1;
+bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> ->
+ 2;
+bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> ->
+ 3;
+bptest(_,_,_) ->
+ error.
+
+
guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments).";
guard_bifs(Config) when is_list(Config) ->
?line Big = -237849247829874297658726487367328971246284736473821617265433,
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index 522caec8f1..a1f61dad67 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -20,23 +20,39 @@
-module(nif_SUITE).
%%-define(line_trace,true).
-%%-define(CHECK(Exp,Got), ?line check(Exp,Got,?LINE)).
--define(CHECK(Exp,Got), ?line Exp = Got).
+-define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
+%%-define(CHECK(Exp,Got), ?line Exp = Got).
-include("test_server.hrl").
--export([all/1, fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
+-export([all/1,
+ %%init_per_testcase/2,
+ fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
types/1, many_args/1, binaries/1, get_string/1, get_atom/1, api_macros/1,
- from_array/1, iolist_as_binary/1, resource/1, resource_takeover/1,
- threading/1, neg/1]).
+ from_array/1, iolist_as_binary/1, resource/1, resource_binary/1, resource_takeover/1,
+ threading/1, send/1, send2/1, send_threaded/1, neg/1, is_checks/1,
+ get_length/1, make_atom/1, make_string/1]).
-export([many_args_100/100]).
+
+
+%% -export([lib_version/0,call_history/0,hold_nif_mod_priv_data/1,nif_mod_call_history/0,
+%% list_seq/1,type_test/0,tuple_2_list/1,is_identical/2,compare/2,
+%% clone_bin/1,make_sub_bin/3,string_to_bin/2,atom_to_bin/2,macros/1,
+%% tuple_2_list_and_tuple/1,iolist_2_bin/1,get_resource_type/1,alloc_resource/2,
+%% make_resource/1,get_resource/2,release_resource/1,last_resource_dtor_call/0,
+%% make_new_resource/2,make_new_resource_binary/1,send_list_seq/2,send_new_blob/2,
+%% alloc_msgenv/0,clear_msgenv/1,grow_blob/2,send_blob/2,send_blob_thread/3,
+%% join_send_thread/1]).
+
+
-define(nif_stub,nif_stub_error(?LINE)).
all(suite) ->
[basic, reload, upgrade, heap_frag, types, many_args, binaries, get_string,
- get_atom, api_macros, from_array, iolist_as_binary, resource,
- resource_takeover, threading, neg].
+ get_atom, api_macros, from_array, iolist_as_binary, resource, resource_binary,
+ resource_takeover, threading, send, send2, send_threaded, neg, is_checks,
+ get_length, make_atom, make_string].
%%init_per_testcase(_Case, Config) ->
%% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)),
@@ -473,12 +489,51 @@ resource_new_do2(Type) ->
{{PtrA,BinA}, {ResB,PtrB,BinB}}.
resource_neg(TypeA) ->
+ resource_neg_do(TypeA),
+
+ catch exit(42), % dummy exception to purge saved stacktraces from earlier exception
+ erlang:garbage_collect(),
+ ?line {_,_,2} = last_resource_dtor_call(),
+ ok.
+
+resource_neg_do(TypeA) ->
TypeB = get_resource_type(1),
- Aptr = alloc_resource(TypeA, <<"Arnold">>),
- Bptr = alloc_resource(TypeB, <<"Bobo">>),
- ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeA, Bptr)),
- ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeB, Aptr)),
+ ResA = make_new_resource(TypeA, <<"Arnold">>),
+ ResB= make_new_resource(TypeB, <<"Bobo">>),
+ ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)),
+ ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)),
+ ok.
+
+resource_binary(doc) -> ["Test enif_make_resource_binary"];
+resource_binary(suite) -> [];
+resource_binary(Config) when is_list(Config) ->
+ ?line ensure_lib_loaded(Config, 1),
+ ?line {Ptr,Bin} = resource_binary_do(),
+ erlang:garbage_collect(),
+ Last = last_resource_dtor_call(),
+ ?CHECK({Ptr,Bin,1}, Last),
ok.
+
+resource_binary_do() ->
+ Bin = <<"Hej Hopp i lingonskogen">>,
+ ?line {Ptr,ResBin1} = make_new_resource_binary(Bin),
+ ?line ResBin1 = Bin,
+ ?line ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1),
+
+ Papa = self(),
+ Forwarder = spawn_link(fun() -> forwarder(Papa) end),
+ io:format("sending to forwarder pid=~p\n",[Forwarder]),
+ Forwarder ! ResBin1,
+ ResBin2 = receive_any(),
+ ?line ResBin2 = ResBin1,
+ ?line ResInfo = get_resource(binary_resource_type,ResBin2),
+ Forwarder ! terminate,
+ ?line {Forwarder, 1} = receive_any(),
+ erlang:garbage_collect(),
+ ?line ResInfo = get_resource(binary_resource_type,ResBin1),
+ ?line ResInfo = get_resource(binary_resource_type,ResBin2),
+ ResInfo.
+
-define(RT_CREATE,1).
-define(RT_TAKEOVER,2).
@@ -743,6 +798,124 @@ threading(Config) when is_list(Config) ->
?line ok = tester:load_nif_lib(Config, "tsd"),
?line ok = tester:run().
+
+send(doc) -> ["Test NIF message sending"];
+send(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ N = 1500,
+ List = lists:seq(1,N),
+ ?line {ok,1} = send_list_seq(N, self),
+ ?line {ok,1} = send_list_seq(N, self()),
+ ?line List = receive_any(),
+ ?line List = receive_any(),
+ Papa = self(),
+ spawn_link(fun() -> ?line {ok,1} = send_list_seq(N, Papa) end),
+ ?line List = receive_any(),
+
+ ?line {ok, 1, BlobS} = send_new_blob(self(), other_term()),
+ ?line BlobR = receive_any(),
+ io:format("Sent ~p\nGot ~p\n", [BlobS, BlobR]),
+ ?line BlobR = BlobS,
+
+ %% send to dead pid
+ {DeadPid, DeadMon} = spawn_monitor(fun() -> void end),
+ ?line {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(),
+ {ok,0} = send_list_seq(7, DeadPid),
+ ok.
+
+send2(doc) -> ["More NIF message sending"];
+send2(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ send2_do1(fun send_blob_dbg/2),
+ ok.
+
+send_threaded(doc) -> ["Send msg from user thread"];
+send_threaded(Config) when is_list(Config) ->
+ case erlang:system_info(smp_support) of
+ true ->
+ send2_do1(fun(ME,To) -> send_blob_thread_dbg(ME,To,join) end),
+ send2_do1(fun(ME,To) -> send_blob_thread_and_join(ME,To) end),
+ ok;
+ false ->
+ {skipped,"No threaded send on non-SMP"}
+ end.
+
+
+send2_do1(SendBlobF) ->
+ io:format("sending to self=~p\n",[self()]),
+ send2_do2(SendBlobF, self()),
+
+ Papa = self(),
+ Forwarder = spawn_link(fun() -> forwarder(Papa) end),
+ io:format("sending to forwarder pid=~p\n",[Forwarder]),
+ send2_do2(SendBlobF, Forwarder),
+ Forwarder ! terminate,
+ ?line {Forwarder, 4} = receive_any(),
+ ok.
+
+send2_do2(SendBlobF, To) ->
+ MsgEnv = alloc_msgenv(),
+ repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
+ ?line {ok,1,Blob0} = SendBlobF(MsgEnv, To),
+ ?line Blob1 = receive_any(),
+ ?line Blob1 = Blob0,
+
+ clear_msgenv(MsgEnv),
+ repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
+ ?line {ok,1,Blob2} = SendBlobF(MsgEnv, To),
+ ?line Blob3 = receive_any(),
+ ?line Blob3 = Blob2,
+
+ clear_msgenv(MsgEnv),
+ repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
+
+ clear_msgenv(MsgEnv),
+ repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
+ ?line {ok,1,Blob4} = SendBlobF(MsgEnv, To),
+ ?line Blob5 = receive_any(),
+ ?line Blob5 = Blob4,
+
+ clear_msgenv(MsgEnv),
+ clear_msgenv(MsgEnv),
+ repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
+ ?line {ok,1,Blob6} = SendBlobF(MsgEnv, To),
+ ?line Blob7 = receive_any(),
+ ?line Blob7 = Blob6,
+
+ ok.
+
+
+send_blob_thread_and_join(MsgEnv, To) ->
+ ?line {ok,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join),
+ ?line {ok,SendRes} = join_send_thread(MsgEnv),
+ {ok,SendRes,Blob}.
+
+send_blob_dbg(MsgEnv, To) ->
+ Ret = send_blob(MsgEnv, To),
+ %%io:format("send_blob to ~p returned ~p\n",[To,Ret]),
+ Ret.
+
+send_blob_thread_dbg(MsgEnv, To, Join) ->
+ Ret = send_blob_thread(MsgEnv, To, Join),
+ %%io:format("send_blob_thread to ~p Join=~p returned ~p\n",[To,Join,Ret]),
+ Ret.
+
+
+forwarder(To) ->
+ forwarder(To, 0).
+forwarder(To, N) ->
+ case receive_any() of
+ terminate ->
+ To ! {self(), N};
+ Msg ->
+ To ! Msg,
+ forwarder(To, N+1)
+ end.
+
+other_term() ->
+ {fun(X,Y) -> X*Y end, make_ref()}.
neg(doc) -> ["Negative testing of load_nif"];
neg(Config) when is_list(Config) ->
@@ -759,7 +932,17 @@ neg(Config) when is_list(Config) ->
?line verify_tmpmem(TmpMem),
?line ok.
+is_checks(doc) -> ["Test all enif_is functions"];
+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">>]}).
+get_length(doc) -> ["Test all enif_get_length functions"];
+get_length(Config) when is_list(Config) ->
+ ?line ensure_lib_loaded(Config, 1),
+ ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list).
ensure_lib_loaded(Config) ->
ensure_lib_loaded(Config, 1).
@@ -773,6 +956,22 @@ ensure_lib_loaded(Config, Ver) ->
ok
end.
+make_atom(Config) when is_list(Config) ->
+ ?line ensure_lib_loaded(Config, 1),
+ An0Atom = an0atom,
+ An0Atom0 = 'an\000atom\000',
+ ?line Atoms = make_atoms(),
+ ?line 7 = size(Atoms),
+ ?line Atoms = {An0Atom,An0Atom,An0Atom,An0Atom0,An0Atom,An0Atom,An0Atom0}.
+
+make_string(Config) when is_list(Config) ->
+ ?line ensure_lib_loaded(Config, 1),
+ ?line Strings = make_strings(),
+ ?line 4 = size(Strings),
+ A0String = "a0string",
+ A0String0 = [$a,0,$s,$t,$r,$i,$n,$g,0],
+ ?line Strings = {A0String,A0String,A0String,A0String0}.
+
tmpmem() ->
case erlang:system_info({allocator,temp_alloc}) of
false -> undefined;
@@ -821,13 +1020,18 @@ call(Pid,Cmd) ->
receive_any() ->
receive M -> M end.
-%% check(Exp,Got,Line) ->
-%% case Got of
-%% Exp -> Exp;
-%% _ ->
-%% io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]),
-%% Got
-%% end.
+repeat(0, _, Arg) ->
+ Arg;
+repeat(N, Fun, Arg0) ->
+ repeat(N-1, Fun, Fun(Arg0)).
+
+check(Exp,Got,Line) ->
+ case Got of
+ Exp -> Exp;
+ _ ->
+ io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]),
+ Got
+ end.
%% The NIFs:
@@ -855,6 +1059,20 @@ get_resource(_,_) -> ?nif_stub.
release_resource(_) -> ?nif_stub.
last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
+check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
+length_test(_,_,_,_,_) -> ?nif_stub.
+make_atoms() -> ?nif_stub.
+make_strings() -> ?nif_stub.
+make_new_resource_binary(_) -> ?nif_stub.
+send_list_seq(_,_) -> ?nif_stub.
+send_new_blob(_,_) -> ?nif_stub.
+alloc_msgenv() -> ?nif_stub.
+clear_msgenv(_) -> ?nif_stub.
+grow_blob(_,_) -> ?nif_stub.
+send_blob(_,_) -> ?nif_stub.
+send_blob_thread(_,_,_) -> ?nif_stub.
+join_send_thread(_) -> ?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 3ad4f93374..bacf7845e2 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -28,6 +28,12 @@
static int static_cntA; /* zero by default */
static int static_cntB = NIF_SUITE_LIB_VER * 100;
+static ERL_NIF_TERM atom_self;
+static ERL_NIF_TERM atom_ok;
+static ERL_NIF_TERM atom_join;
+static ERL_NIF_TERM atom_binary_resource_type;
+
+
typedef struct
{
int ref_cnt;
@@ -38,7 +44,7 @@ typedef struct
void add_call(ErlNifEnv* env, PrivData* data, const char* func_name)
{
- CallInfo* call = enif_alloc(env, sizeof(CallInfo)+strlen(func_name));
+ CallInfo* call = enif_alloc(sizeof(CallInfo)+strlen(func_name));
strcpy(call->func_name, func_name);
call->lib_ver = NIF_SUITE_LIB_VER;
call->next = data->call_history;
@@ -49,7 +55,7 @@ void add_call(ErlNifEnv* env, PrivData* data, const char* func_name)
call->arg_sz = 0;
}
-#define ADD_CALL(FUNC_NAME) add_call(env, enif_get_data(env),FUNC_NAME)
+#define ADD_CALL(FUNC_NAME) add_call(env, enif_priv_data(env),FUNC_NAME)
static void* resource_dtor_last = NULL;
static unsigned resource_dtor_last_sz = 0;
@@ -60,15 +66,24 @@ static void resource_dtor(ErlNifEnv* env, void* obj)
{
resource_dtor_last = obj;
resource_dtor_cnt++;
- resource_dtor_last_sz = enif_sizeof_resource(env, obj);
+ resource_dtor_last_sz = enif_sizeof_resource(obj);
assert(resource_dtor_last_sz <= sizeof(resource_dtor_last_data));
memcpy(resource_dtor_last_data, obj, resource_dtor_last_sz);
}
+static ErlNifResourceType* msgenv_resource_type;
+static void msgenv_dtor(ErlNifEnv* env, void* obj);
+
+static ErlNifResourceType* binary_resource_type;
+static void binary_resource_dtor(ErlNifEnv* env, void* obj);
+struct binary_resource {
+ unsigned char* data;
+ unsigned size;
+};
+
static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
{
- /*ERL_NIF_TERM head, tail;*/
- PrivData* data = enif_alloc(env, sizeof(PrivData));
+ PrivData* data = enif_alloc(sizeof(PrivData));
assert(data != NULL);
data->ref_cnt = 1;
data->call_history = NULL;
@@ -76,41 +91,71 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
add_call(env, data, "load");
- /*
- head = load_info;
- data->rt_cnt = 0;
- for (head=load_info; enif_get_list_cell(env,load_info,&head,&tail);
- head=tail) {
- char buf[20];
- int n = enif_get_string(env,head,buf,sizeof(buf));
- assert(n > 0);
- assert(i < sizeof(data->rt_arr)/sizeof(*data->rt_arr));
- data->rt_arr[data->rt_cnt++].t = enif_create_resource_type(env,buf,resource_dtor,
- ERL_NIF_RT_CREATE,NULL);
- }
- assert(enif_is_empty_list(env,head));
- */
- data->rt_arr[0].t = enif_open_resource_type(env,"Gold",resource_dtor,
+ data->rt_arr[0].t = enif_open_resource_type(env,NULL,"Gold",resource_dtor,
ERL_NIF_RT_CREATE,NULL);
- data->rt_arr[1].t = enif_open_resource_type(env,"Silver",resource_dtor,
+ data->rt_arr[1].t = enif_open_resource_type(env,NULL,"Silver",resource_dtor,
ERL_NIF_RT_CREATE,NULL);
+ binary_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.binary",
+ binary_resource_dtor,
+ ERL_NIF_RT_CREATE, NULL);
+
+ msgenv_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.msgenv",
+ msgenv_dtor,
+ ERL_NIF_RT_CREATE, NULL);
+
+ atom_self = enif_make_atom(env,"self");
+ atom_ok = enif_make_atom(env,"ok");
+ atom_join = enif_make_atom(env,"join");
+ atom_binary_resource_type = enif_make_atom(env,"binary_resource_type");
+
*priv_data = data;
return 0;
}
+static void resource_takeover(ErlNifEnv* env, PrivData* priv)
+{
+ ErlNifResourceFlags tried;
+ ErlNifResourceType* rt;
+ rt = enif_open_resource_type(env, NULL, "Gold", resource_dtor,
+ ERL_NIF_RT_TAKEOVER, &tried);
+ assert(rt == priv->rt_arr[0].t);
+ assert(tried == ERL_NIF_RT_TAKEOVER);
+ rt = enif_open_resource_type(env, NULL, "Silver", resource_dtor,
+ ERL_NIF_RT_TAKEOVER, &tried);
+ assert(rt == priv->rt_arr[1].t);
+ assert(tried == ERL_NIF_RT_TAKEOVER);
+
+ rt = enif_open_resource_type(env, NULL, "nif_SUITE.binary", binary_resource_dtor,
+ ERL_NIF_RT_TAKEOVER, &tried);
+ assert(rt != NULL);
+ assert(tried == ERL_NIF_RT_TAKEOVER);
+ assert(binary_resource_type==NULL || binary_resource_type == rt);
+ binary_resource_type = rt;
+
+ rt = enif_open_resource_type(env, NULL, "nif_SUITE.msgenv", msgenv_dtor,
+ ERL_NIF_RT_TAKEOVER, &tried);
+ assert(rt != NULL);
+ assert(tried == ERL_NIF_RT_TAKEOVER);
+ assert(msgenv_resource_type==NULL || msgenv_resource_type == rt);
+ msgenv_resource_type = rt;
+}
+
static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
{
- add_call(env, *priv_data, "reload");
+ PrivData* priv = (PrivData*) *priv_data;
+ add_call(env, priv, "reload");
+ resource_takeover(env,priv);
return 0;
}
static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
{
- PrivData* data = *old_priv_data;
- add_call(env, data, "upgrade");
- data->ref_cnt++;
- *priv_data = *old_priv_data;
+ PrivData* priv = (PrivData*) *old_priv_data;
+ add_call(env, priv, "upgrade");
+ priv->ref_cnt++;
+ *priv_data = *old_priv_data;
+ resource_takeover(env,priv);
return 0;
}
@@ -119,7 +164,10 @@ static void unload(ErlNifEnv* env, void* priv_data)
PrivData* data = priv_data;
add_call(env, data, "unload");
if (--data->ref_cnt == 0) {
- enif_free(env, priv_data);
+ if (data->nif_mod != NULL) {
+ NifModPrivData_release(data->nif_mod);
+ }
+ enif_free(priv_data);
}
}
@@ -149,28 +197,28 @@ static ERL_NIF_TERM make_call_history(ErlNifEnv* env, CallInfo** headp)
enif_make_int(env,call->static_cntB));
list = enif_make_list_cell(env, tpl, list);
*headp = call->next;
- enif_free(env,call);
+ enif_free(call);
}
return list;
}
static ERL_NIF_TERM call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- PrivData* data = (PrivData*) enif_get_data(env);
+ PrivData* data = (PrivData*) enif_priv_data(env);
return make_call_history(env,&data->call_history);
}
static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- PrivData* data = (PrivData*) enif_get_data(env);
+ PrivData* data = (PrivData*) enif_priv_data(env);
unsigned long ptr_as_ulong;
if (!enif_get_ulong(env,argv[0],&ptr_as_ulong)) {
return enif_make_badarg(env);
}
- if (data->nif_mod != NULL && --(data->nif_mod->ref_cnt) == 0) {
- enif_free(env,data->nif_mod);
+ if (data->nif_mod != NULL) {
+ NifModPrivData_release(data->nif_mod);
}
data->nif_mod = (NifModPrivData*) ptr_as_ulong;
return enif_make_int(env,++(data->nif_mod->ref_cnt));
@@ -178,7 +226,7 @@ static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, int argc, const ERL_N
static ERL_NIF_TERM nif_mod_call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- PrivData* data = (PrivData*) enif_get_data(env);
+ PrivData* data = (PrivData*) enif_priv_data(env);
ERL_NIF_TERM ret;
if (data->nif_mod == NULL) {
return enif_make_string(env,"nif_mod pointer is NULL", ERL_NIF_LATIN1);
@@ -354,13 +402,13 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
}
}
- if (!enif_make_existing_atom(env,"nif_SUITE", &atom)
- || !enif_is_identical(env,atom,enif_make_atom(env,"nif_SUITE"))) {
+ if (!enif_make_existing_atom(env,"nif_SUITE", &atom, ERL_NIF_LATIN1)
+ || !enif_is_identical(atom,enif_make_atom(env,"nif_SUITE"))) {
fprintf(stderr, "nif_SUITE not an atom?\r\n");
goto error;
}
for (i=2; i; i--) {
- if (enif_make_existing_atom(env,"nif_SUITE_pink_unicorn", &atom)) {
+ if (enif_make_existing_atom(env,"nif_SUITE_pink_unicorn", &atom, ERL_NIF_LATIN1)) {
fprintf(stderr, "pink unicorn exist?\r\n");
goto error;
}
@@ -368,7 +416,7 @@ static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
ref1 = enif_make_ref(env);
ref2 = enif_make_ref(env);
if (!enif_is_ref(env,ref1) || !enif_is_ref(env,ref2)
- || enif_is_identical(env,ref1,ref2) || enif_compare(env,ref1,ref2)==0) {
+ || enif_is_identical(ref1,ref2) || enif_compare(ref1,ref2)==0) {
fprintf(stderr, "strange refs?\r\n");
goto error;
}
@@ -398,7 +446,7 @@ static ERL_NIF_TERM is_identical(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
if (argc != 2) {
return enif_make_badarg(env);
}
- return enif_make_atom(env, (enif_is_identical(env,argv[0],argv[1]) ?
+ return enif_make_atom(env, (enif_is_identical(argv[0],argv[1]) ?
"true" : "false"));
}
@@ -407,7 +455,7 @@ static ERL_NIF_TERM compare(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
if (argc != 2) {
return enif_make_badarg(env);
}
- return enif_make_int(env, enif_compare(env,argv[0],argv[1]));
+ return enif_make_int(env, enif_compare(argv[0],argv[1]));
}
static ERL_NIF_TERM many_args_100(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -454,7 +502,7 @@ static ERL_NIF_TERM string_to_bin(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
unsigned size;
int n;
if (!enif_get_int(env,argv[1],(int*)&size)
- || !enif_alloc_binary(env,size,&obin)) {
+ || !enif_alloc_binary(size,&obin)) {
return enif_make_badarg(env);
}
n = enif_get_string(env, argv[0], (char*)obin.data, size, ERL_NIF_LATIN1);
@@ -468,10 +516,10 @@ static ERL_NIF_TERM atom_to_bin(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
unsigned size;
int n;
if (!enif_get_int(env,argv[1],(int*)&size)
- || !enif_alloc_binary(env,size,&obin)) {
+ || !enif_alloc_binary(size,&obin)) {
return enif_make_badarg(env);
}
- n = enif_get_atom(env, argv[0], (char*)obin.data, size);
+ n = enif_get_atom(env, argv[0], (char*)obin.data, size, ERL_NIF_LATIN1);
return enif_make_tuple(env, 2, enif_make_int(env,n),
enif_make_binary(env,&obin));
}
@@ -552,7 +600,7 @@ static ERL_NIF_TERM last_resource_dtor_call(ErlNifEnv* env, int argc, const ERL_
static ERL_NIF_TERM get_resource_type(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- PrivData* data = (PrivData*) enif_get_data(env);
+ PrivData* data = (PrivData*) enif_priv_data(env);
int ix;
if (!enif_get_int(env, argv[0], &ix) || ix >= 2) {
@@ -568,7 +616,7 @@ static ERL_NIF_TERM alloc_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM
union { void* p; long l;} data;
if (!enif_get_long(env, argv[0], &type.l)
|| !enif_inspect_binary(env, argv[1], &data_bin)
- || (data.p = enif_alloc_resource(env, type.t, data_bin.size))==NULL) {
+ || (data.p = enif_alloc_resource(type.t, data_bin.size))==NULL) {
return enif_make_badarg(env);
}
@@ -593,28 +641,65 @@ static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TE
ERL_NIF_TERM ret;
if (!enif_get_long(env, argv[0], &type.l)
|| !enif_inspect_binary(env, argv[1], &data_bin)
- || (data = enif_alloc_resource(env, type.t, data_bin.size))==NULL) {
+ || (data = enif_alloc_resource(type.t, data_bin.size))==NULL) {
return enif_make_badarg(env);
}
ret = enif_make_resource(env, data);
memcpy(data, data_bin.data, data_bin.size);
- enif_release_resource(env, data);
+ enif_release_resource(data);
return ret;
}
+static ERL_NIF_TERM make_new_resource_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifBinary data_bin;
+ union { struct binary_resource* p; void* vp; long l;} br;
+ void* buf;
+ ERL_NIF_TERM ret;
+ if (!enif_inspect_binary(env, argv[0], &data_bin)
+ || (br.vp = enif_alloc_resource(binary_resource_type,
+ sizeof(struct binary_resource)))==NULL
+ || (buf = enif_alloc(data_bin.size)) == NULL) {
+
+ return enif_make_badarg(env);
+ }
+ memset(br.vp,0xba,sizeof(struct binary_resource)); /* avoid valgrind warning */
+ br.p->data = buf;
+ br.p->size = data_bin.size;
+ memcpy(br.p->data, data_bin.data, data_bin.size);
+ ret = enif_make_resource_binary(env, br.vp, br.p->data, br.p->size);
+ enif_release_resource(br.p);
+ return enif_make_tuple2(env, enif_make_long(env,br.l), ret);
+}
+
+static void binary_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ struct binary_resource* br = (struct binary_resource*) obj;
+ resource_dtor(env,obj);
+ assert(br->data != NULL);
+ enif_free(br->data);
+ br->data = NULL;
+}
+
static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifBinary data_bin;
union { ErlNifResourceType* t; long l; } type;
union { void* p; long l; } data;
- if (!enif_get_long(env, argv[0], &type.l)
+ type.t = NULL;
+ if (enif_is_identical(argv[0], atom_binary_resource_type)) {
+ type.t = binary_resource_type;
+ }
+ else {
+ enif_get_long(env, argv[0], &type.l);
+ }
+ if (type.t == NULL
|| !enif_get_resource(env, argv[1], type.t, &data.p)) {
return enif_make_badarg(env);
}
-
- enif_alloc_binary(env, enif_sizeof_resource(env,data.p), &data_bin);
+ enif_alloc_binary(enif_sizeof_resource(data.p), &data_bin);
memcpy(data_bin.data, data.p, data_bin.size);
return enif_make_tuple2(env, enif_make_long(env,data.l),
enif_make_binary(env, &data_bin));
@@ -626,10 +711,546 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER
if (!enif_get_long(env, argv[0], &data.l)) {
return enif_make_badarg(env);
}
- enif_release_resource(env, data.p);
+ enif_release_resource(data.p);
return enif_make_atom(env,"ok");
}
+/*
+ * argv[0] an atom
+ * argv[1] a binary
+ * argv[2] a ref
+ * argv[3] 'ok'
+ * argv[4] a fun
+ * argv[5] a pid
+ * argv[6] a port
+ * argv[7] an empty list
+ * argv[8] a non-empty list
+ * argv[9] a tuple
+ */
+static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM ok_atom = enif_make_atom(env, "ok");
+
+ if (!enif_is_atom(env, argv[0])) return enif_make_badarg(env);
+ if (!enif_is_binary(env, argv[1])) return enif_make_badarg(env);
+ if (!enif_is_ref(env, argv[2])) return enif_make_badarg(env);
+ if (!enif_is_identical(argv[3], ok_atom)) return enif_make_badarg(env);
+ if (!enif_is_fun(env, argv[4])) return enif_make_badarg(env);
+ if (!enif_is_pid(env, argv[5])) return enif_make_badarg(env);
+ if (!enif_is_port(env, argv[6])) return enif_make_badarg(env);
+ if (!enif_is_empty_list(env, argv[7])) return enif_make_badarg(env);
+ 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);
+
+ return ok_atom;
+}
+
+/*
+ * argv[0] atom with length of 6
+ * argv[1] list with length of 6
+ * argv[2] empty list
+ * argv[3] not an atom
+ * argv[4] not a list
+ */
+static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ unsigned len;
+
+ if (!enif_get_atom_length(env, argv[0], &len, ERL_NIF_LATIN1) || len != 6)
+ return enif_make_badarg(env);
+
+ if (!enif_get_list_length(env, argv[1], &len) || len != 6)
+ return enif_make_badarg(env);
+
+ if (!enif_get_list_length(env, argv[2], &len) || len != 0)
+ return enif_make_badarg(env);
+
+ if (enif_get_atom_length(env, argv[3], &len, ERL_NIF_LATIN1))
+ return enif_make_badarg(env);
+
+ if (enif_get_list_length(env, argv[4], &len))
+ return enif_make_badarg(env);
+
+ return enif_make_atom(env, "ok");
+}
+
+static ERL_NIF_TERM make_atoms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM arr[7];
+ ERL_NIF_TERM existingatom0a, existingatom0b;
+ ERL_NIF_TERM existing0atom0;
+ const char * const an0atom = "an0atom";
+ const char an0atom0[8] = {'a','n','\0','a','t','o','m',0};
+
+ arr[0] = enif_make_atom(env, "an0atom");
+ arr[1] = enif_make_atom_len(env, "an0atom", 7);
+ arr[2] = enif_make_atom_len(env, an0atom, 7);
+ arr[3] = enif_make_atom_len(env, an0atom0, 8);
+
+ if (!enif_make_existing_atom(env, "an0atom", &existingatom0a, ERL_NIF_LATIN1))
+ return enif_make_atom(env, "error");
+ arr[4] = existingatom0a;
+
+ if (!enif_make_existing_atom_len(env, an0atom, 7, &existingatom0b, ERL_NIF_LATIN1))
+ return enif_make_atom(env, "error");
+ arr[5] = existingatom0b;
+
+ if (!enif_make_existing_atom_len(env, an0atom0, 8, &existing0atom0, ERL_NIF_LATIN1))
+ return enif_make_atom(env, "error");
+ arr[6] = existing0atom0;
+
+ return enif_make_tuple7(env,
+ arr[0],arr[1],arr[2],arr[3],arr[4],arr[5],arr[6]);
+}
+
+static ERL_NIF_TERM make_strings(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ const char a0string[8] = {'a','0','s','t','r','i','n','g'};
+ const char a0string0[9] = {'a','\0','s','t','r','i','n','g',0};
+
+ return enif_make_tuple4(env,
+ enif_make_string(env, "a0string", ERL_NIF_LATIN1),
+ enif_make_string_len(env, "a0string", 8, ERL_NIF_LATIN1),
+ enif_make_string_len(env, a0string, 8, ERL_NIF_LATIN1),
+ enif_make_string_len(env, a0string0, 9, ERL_NIF_LATIN1));
+}
+static ERL_NIF_TERM send_list_seq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid to;
+ ERL_NIF_TERM msg;
+ ErlNifEnv* msg_env;
+ int i, res;
+
+ if (!enif_get_int(env, argv[0], &i)) {
+ return enif_make_badarg(env);
+ }
+ if (argv[1] == atom_self) {
+ enif_self(env, &to);
+ }
+ else if (!enif_get_local_pid(env, argv[1], &to)) {
+ return enif_make_badarg(env);
+ }
+ msg_env = enif_alloc_env();
+ msg = enif_make_list(msg_env,0);
+ for ( ; i>0 ; i--) {
+ msg = enif_make_list_cell(msg_env, enif_make_int(msg_env, i), msg);
+ }
+ res = enif_send(env, &to, msg_env, msg);
+ enif_free_env(msg_env);
+ return enif_make_tuple2(env, atom_ok, enif_make_int(env,res));
+}
+
+static void fill(void* dst, unsigned bytes, int seed)
+{
+ unsigned char* ptr = dst;
+ int i;
+ for (i=bytes; i>0; i--) {
+ *ptr++ = seed;
+ seed += 7;
+ }
+}
+
+#define MAKE_TERM_REUSE_LEN 16
+struct make_term_info
+{
+ ErlNifEnv* caller_env;
+ ErlNifEnv* dst_env;
+ ERL_NIF_TERM reuse[MAKE_TERM_REUSE_LEN];
+ unsigned reuse_push;
+ unsigned reuse_pull;
+ ErlNifResourceType* resource_type;
+ ERL_NIF_TERM other_term;
+ ERL_NIF_TERM blob;
+ ErlNifPid to_pid;
+ ErlNifTid tid;
+ ErlNifCond* cond;
+ ErlNifMutex* mtx;
+ int send_it;
+ int send_res;
+ unsigned n;
+};
+
+
+static void push_term(struct make_term_info* mti, ERL_NIF_TERM term)
+{
+ unsigned ix = (mti->reuse_push++) % MAKE_TERM_REUSE_LEN;
+ mti->reuse[ix] = term;
+ //enif_fprintf(stderr, "push at %u: %T\r\n", ix, term);
+}
+static ERL_NIF_TERM pull_term(struct make_term_info* mti)
+{
+ unsigned ix;
+ if (mti->reuse_pull >= mti->reuse_push &&
+ mti->reuse_push < MAKE_TERM_REUSE_LEN) {
+ mti->reuse_pull = 0;
+ if (mti->reuse_push == 0) {
+ mti->reuse[0] = enif_make_list(mti->dst_env, 0);
+ }
+ }
+ ix = (mti->reuse_pull++) % MAKE_TERM_REUSE_LEN;
+ //enif_fprintf(stderr, "pull from %u: %T\r\n", ix, mti->reuse[ix]);
+ return mti->reuse[ix];
+}
+
+static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res);
+
+static ERL_NIF_TERM make_term_binary(struct make_term_info* mti, int n)
+{
+ ErlNifBinary bin;
+ enif_alloc_binary(100, &bin);
+ fill(bin.data, bin.size, n);
+ return enif_make_binary(mti->dst_env, &bin);
+}
+
+static ERL_NIF_TERM make_term_int(struct make_term_info* mti, int n)
+{
+ int i;
+ fill(&i, sizeof(i), n);
+ return enif_make_int(mti->dst_env, i);
+}
+
+static ERL_NIF_TERM make_term_ulong(struct make_term_info* mti, int n)
+{
+ unsigned long ul;
+ fill(&ul, sizeof(ul), n);
+ return enif_make_ulong(mti->dst_env, ul);
+}
+
+static ERL_NIF_TERM make_term_double(struct make_term_info* mti, int n)
+{
+ double d = 3.141592;
+ return enif_make_double(mti->dst_env, d);
+}
+static ERL_NIF_TERM make_term_atom(struct make_term_info* mti, int n)
+{
+ return enif_make_atom(mti->dst_env, "make_term_n");
+}
+static ERL_NIF_TERM make_term_existing_atom(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM res;
+ int exist = enif_make_existing_atom(mti->dst_env, "nif_SUITE", &res,
+ ERL_NIF_LATIN1);
+ assert(exist);
+ return res;
+}
+static ERL_NIF_TERM make_term_string(struct make_term_info* mti, int n)
+{
+ return enif_make_string(mti->dst_env, "Hello!", ERL_NIF_LATIN1);
+}
+static ERL_NIF_TERM make_term_ref(struct make_term_info* mti, int n)
+{
+ return enif_make_ref(mti->dst_env);
+}
+static ERL_NIF_TERM make_term_sub_binary(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM orig;
+ unsigned char* ptr = enif_make_new_binary(mti->dst_env, 10, &orig);
+ fill(ptr, 10, n);
+ return enif_make_sub_binary(mti->dst_env, orig, 3, 5);
+}
+static ERL_NIF_TERM make_term_uint(struct make_term_info* mti, int n)
+{
+ unsigned int ui;
+ fill(&ui, sizeof(ui), n);
+ return enif_make_uint(mti->dst_env, ui);
+}
+static ERL_NIF_TERM make_term_long(struct make_term_info* mti, int n)
+{
+ long l;
+ fill(&l, sizeof(l), n);
+ return enif_make_long(mti->dst_env, l);
+}
+static ERL_NIF_TERM make_term_tuple0(struct make_term_info* mti, int n)
+{
+ return enif_make_tuple(mti->dst_env, 0);
+}
+static ERL_NIF_TERM make_term_list0(struct make_term_info* mti, int n)
+{
+ return enif_make_list(mti->dst_env, 0);
+}
+static ERL_NIF_TERM make_term_resource(struct make_term_info* mti, int n)
+{
+ void* resource = enif_alloc_resource(mti->resource_type, 10);
+ fill(resource, 10, n);
+ return enif_make_resource(mti->dst_env, resource);
+}
+static ERL_NIF_TERM make_term_new_binary(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM res;
+ unsigned char* ptr = enif_make_new_binary(mti->dst_env,20,&res);
+ fill(ptr, 20, n);
+ return res;
+}
+static ERL_NIF_TERM make_term_caller_pid(struct make_term_info* mti, int n)
+{
+ ErlNifPid pid;
+ return enif_make_pid(mti->dst_env, enif_self(mti->caller_env, &pid));
+}
+
+static ERL_NIF_TERM make_term_tuple(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM t[3];
+ t[0] = pull_term(mti);
+ t[1] = pull_term(mti);
+ t[2] = pull_term(mti);
+ return enif_make_tuple3(mti->dst_env, t[0], t[1], t[2]);
+}
+static ERL_NIF_TERM make_term_list(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM t[3];
+ t[0] = pull_term(mti);
+ t[1] = pull_term(mti);
+ t[2] = pull_term(mti);
+ return enif_make_list3(mti->dst_env, t[0], t[1], t[2]);
+}
+static ERL_NIF_TERM make_term_list_cell(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM t[2];
+ t[0] = pull_term(mti);
+ t[1] = pull_term(mti);
+ return enif_make_list_cell(mti->dst_env, t[0], t[1]);
+}
+static ERL_NIF_TERM make_term_tuple_from_array(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM t[3];
+ t[0] = pull_term(mti);
+ t[1] = pull_term(mti);
+ t[2] = pull_term(mti);
+ return enif_make_tuple_from_array(mti->dst_env, t, 3);
+}
+static ERL_NIF_TERM make_term_list_from_array(struct make_term_info* mti, int n)
+{
+ ERL_NIF_TERM t[3];
+ t[0] = pull_term(mti);
+ t[1] = pull_term(mti);
+ t[2] = pull_term(mti);
+ return enif_make_list_from_array(mti->dst_env, t, 3);
+}
+static ERL_NIF_TERM make_term_garbage(struct make_term_info* mti, int n)
+{
+ (void) enif_make_string(mti->dst_env, "garbage string", ERL_NIF_LATIN1);
+ return pull_term(mti);
+}
+static ERL_NIF_TERM make_term_copy(struct make_term_info* mti, int n)
+{
+ return enif_make_copy(mti->dst_env, mti->other_term);
+}
+static int make_term_n(struct make_term_info* mti, int n, ERL_NIF_TERM* res)
+{
+ typedef ERL_NIF_TERM Make_term_Func(struct make_term_info*, int);
+ static Make_term_Func* funcs[] = {
+ make_term_binary,
+ make_term_int,
+ make_term_ulong,
+ make_term_double,
+ make_term_atom,
+ make_term_existing_atom,
+ make_term_string,
+ //make_term_ref,
+ make_term_sub_binary,
+ make_term_uint,
+ make_term_long,
+ make_term_tuple0,
+ make_term_list0,
+ make_term_resource,
+ make_term_new_binary,
+ make_term_caller_pid,
+ make_term_tuple,
+ make_term_list,
+ make_term_list_cell,
+ make_term_tuple_from_array,
+ make_term_list_from_array,
+ make_term_garbage,
+ make_term_copy
+ };
+ if (n < sizeof(funcs)/sizeof(*funcs)) {
+ *res = funcs[n](mti, n);
+ push_term(mti, *res);
+ return 1;
+ }
+ return 0;
+}
+
+static ERL_NIF_TERM make_blob(ErlNifEnv* caller_env, ErlNifEnv* dst_env,
+ ERL_NIF_TERM other_term)
+{
+ PrivData* priv = (PrivData*) enif_priv_data(caller_env);
+ ERL_NIF_TERM term, list;
+ int n = 0;
+ struct make_term_info mti;
+ mti.caller_env = caller_env;
+ mti.dst_env = dst_env;
+ mti.reuse_push = 0;
+ mti.reuse_pull = 0;
+ mti.resource_type = priv->rt_arr[0].t;
+ mti.other_term = other_term;
+
+ list = enif_make_list(dst_env, 0);
+ while (make_term_n(&mti, n++, &term)) {
+ list = enif_make_list_cell(dst_env, term, list);
+ }
+ return list;
+}
+
+static ERL_NIF_TERM send_new_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid to;
+ ERL_NIF_TERM msg, copy;
+ ErlNifEnv* msg_env;
+ int res;
+
+ if (!enif_get_local_pid(env, argv[0], &to)) {
+ return enif_make_badarg(env);
+ }
+ msg_env = enif_alloc_env();
+ msg = make_blob(env,msg_env, argv[1]);
+ copy = make_blob(env,env, argv[1]);
+ res = enif_send(env, &to, msg_env, msg);
+ enif_free_env(msg_env);
+ return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy);
+}
+
+static ERL_NIF_TERM alloc_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ PrivData* priv = (PrivData*) enif_priv_data(env);
+ struct make_term_info* mti;
+ ERL_NIF_TERM ret;
+
+ mti = (struct make_term_info*) enif_alloc_resource(msgenv_resource_type,
+ sizeof(*mti));
+ mti->caller_env = NULL;
+ mti->dst_env = enif_alloc_env();
+ mti->reuse_push = 0;
+ mti->reuse_pull = 0;
+ mti->resource_type = priv->rt_arr[0].t;
+ mti->other_term = enif_make_list(mti->dst_env, 0);
+ mti->blob = enif_make_list(mti->dst_env, 0);
+ mti->mtx = enif_mutex_create("nif_SUITE:mtx");
+ mti->cond = enif_cond_create("nif_SUITE:cond");
+ mti->send_res = 0xcafebabe;
+ mti->n = 0;
+ ret = enif_make_resource(env, mti);
+ enif_release_resource(mti);
+ return ret;
+}
+
+static void msgenv_dtor(ErlNifEnv* env, void* obj)
+{
+ struct make_term_info* mti = (struct make_term_info*) obj;
+ if (mti->dst_env != NULL) {
+ enif_free_env(mti->dst_env);
+ }
+ enif_mutex_destroy(mti->mtx);
+ enif_cond_destroy(mti->cond);
+}
+
+static ERL_NIF_TERM clear_msgenv(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ union {
+ void* vp;
+ struct make_term_info* p;
+ }mti;
+ if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) {
+ return enif_make_badarg(env);
+ }
+ enif_clear_env(mti.p->dst_env);
+ mti.p->reuse_pull = 0;
+ mti.p->reuse_push = 0;
+ mti.p->blob = enif_make_list(mti.p->dst_env, 0);
+ return atom_ok;
+}
+
+static ERL_NIF_TERM grow_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ union { void* vp; struct make_term_info* p; }mti;
+ ERL_NIF_TERM term;
+ if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) {
+ return enif_make_badarg(env);
+ }
+ mti.p->caller_env = env;
+ mti.p->other_term = argv[1];
+ while (!make_term_n(mti.p, mti.p->n++, &term)) {
+ mti.p->n = 0;
+ }
+ mti.p->blob = enif_make_list_cell(mti.p->dst_env, term, mti.p->blob);
+ return atom_ok;
+}
+
+static ERL_NIF_TERM send_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ union { void* vp; struct make_term_info* p; }mti;
+ ErlNifPid to;
+ ERL_NIF_TERM copy;
+ int res;
+ if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)
+ || !enif_get_local_pid(env, argv[1], &to)) {
+ return enif_make_badarg(env);
+ }
+ copy = enif_make_copy(env, mti.p->blob);
+ res = enif_send(env, &to, mti.p->dst_env, mti.p->blob);
+ return enif_make_tuple3(env, atom_ok, enif_make_int(env,res), copy);
+}
+
+void* threaded_sender(void *arg)
+{
+
+ union { void* vp; struct make_term_info* p; }mti;
+ mti.vp = arg;
+
+ enif_mutex_lock(mti.p->mtx);
+ while (!mti.p->send_it) {
+ enif_cond_wait(mti.p->cond, mti.p->mtx);
+ }
+ mti.p->send_it = 0;
+ enif_mutex_unlock(mti.p->mtx);
+ mti.p->send_res = enif_send(NULL, &mti.p->to_pid, mti.p->dst_env, mti.p->blob);
+ return NULL;
+}
+
+static ERL_NIF_TERM send_blob_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ union { void* vp; struct make_term_info* p; }mti;
+ ERL_NIF_TERM copy;
+ if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)
+ || !enif_get_local_pid(env,argv[1], &mti.p->to_pid)) {
+ return enif_make_badarg(env);
+ }
+ copy = enif_make_copy(env, mti.p->blob);
+
+ mti.p->send_it = enif_is_identical(argv[2],atom_join);
+ if (enif_thread_create("nif_SUITE:send_from_thread", &mti.p->tid,
+ threaded_sender, mti.p, NULL) != 0) {
+ return enif_make_badarg(env);
+ }
+ if (enif_is_identical(argv[2],atom_join)) {
+ int err = enif_thread_join(mti.p->tid, NULL);
+ assert(err == 0);
+ return enif_make_tuple3(env, atom_ok, enif_make_int(env, mti.p->send_res), copy);
+ }
+ else {
+ enif_keep_resource(mti.vp);
+ return enif_make_tuple2(env, atom_ok, copy);
+ }
+}
+
+static ERL_NIF_TERM join_send_thread(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ union { void* vp; struct make_term_info* p; }mti;
+ int err;
+ if (!enif_get_resource(env, argv[0], msgenv_resource_type, &mti.vp)) {
+ return enif_make_badarg(env);
+ }
+ enif_mutex_lock(mti.p->mtx);
+ mti.p->send_it = 1;
+ enif_cond_signal(mti.p->cond);
+ enif_mutex_unlock(mti.p->mtx);
+ err = enif_thread_join(mti.p->tid, NULL);
+ assert(err == 0);
+ enif_release_resource(mti.vp);
+ return enif_make_tuple2(env, atom_ok, enif_make_int(env, mti.p->send_res));
+}
+
static ErlNifFunc nif_funcs[] =
{
@@ -656,8 +1277,21 @@ static ErlNifFunc nif_funcs[] =
{"get_resource", 2, get_resource},
{"release_resource", 1, release_resource},
{"last_resource_dtor_call", 0, last_resource_dtor_call},
- {"make_new_resource", 2, make_new_resource}
-
+ {"make_new_resource", 2, make_new_resource},
+ {"check_is", 10, check_is},
+ {"length_test", 5, length_test},
+ {"make_atoms", 0, make_atoms},
+ {"make_strings", 0, make_strings},
+ {"make_new_resource", 2, make_new_resource},
+ {"make_new_resource_binary", 1, make_new_resource_binary},
+ {"send_list_seq", 2, send_list_seq},
+ {"send_new_blob", 2, send_new_blob},
+ {"alloc_msgenv", 0, alloc_msgenv},
+ {"clear_msgenv", 1, clear_msgenv},
+ {"grow_blob", 2, grow_blob},
+ {"send_blob", 2, send_blob},
+ {"send_blob_thread", 3, send_blob_thread},
+ {"join_send_thread", 1, join_send_thread}
};
ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload)
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c
index 75df9d56d5..e32d10057c 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c
@@ -42,6 +42,11 @@ static ERL_NIF_TERM am_resource_type;
static ERL_NIF_TERM am_resource_dtor_A;
static ERL_NIF_TERM am_resource_dtor_B;
+static NifModPrivData* priv_data(ErlNifEnv* env)
+{
+ return (NifModPrivData*) enif_priv_data(env);
+}
+
static void init(ErlNifEnv* env)
{
am_true = enif_make_atom(env, "true");
@@ -54,7 +59,7 @@ static void init(ErlNifEnv* env)
static void add_call_with_arg(ErlNifEnv* env, NifModPrivData* data, const char* func_name,
const char* arg, int arg_sz)
{
- CallInfo* call = enif_alloc(env, sizeof(CallInfo)+strlen(func_name) + arg_sz);
+ CallInfo* call = (CallInfo*)enif_alloc(sizeof(CallInfo)+strlen(func_name) + arg_sz);
strcpy(call->func_name, func_name);
call->lib_ver = NIF_LIB_VER;
call->static_cntA = ++static_cntA;
@@ -78,7 +83,7 @@ static void add_call(ErlNifEnv* env, NifModPrivData* data,const char* func_name)
add_call_with_arg(env, data, func_name, NULL, 0);
}
-#define ADD_CALL(FUNC_NAME) add_call(env, enif_priv_data(env),FUNC_NAME)
+#define ADD_CALL(FUNC_NAME) add_call(env, priv_data(env),FUNC_NAME)
#define STRINGIFY_(X) #X
#define STRINGIFY(X) STRINGIFY_(X)
@@ -87,56 +92,56 @@ static void resource_dtor_A(ErlNifEnv* env, void* a)
{
const char dtor_name[] = "resource_dtor_A_v" STRINGIFY(NIF_LIB_VER);
- add_call_with_arg(env, enif_priv_data(env), dtor_name,
- a, enif_sizeof_resource(env, a));
+ add_call_with_arg(env, priv_data(env), dtor_name, (const char*)a,
+ enif_sizeof_resource(a));
}
static void resource_dtor_B(ErlNifEnv* env, void* a)
{
- const char dtor_name[] = "resource_dtor_B_v" STRINGIFY(NIF_LIB_VER);
+ const char dtor_name[] = "resource_dtor_B_v" STRINGIFY(NIF_LIB_VER);
- add_call_with_arg(env, enif_priv_data(env), dtor_name,
- a, enif_sizeof_resource(env, a));
+ add_call_with_arg(env, priv_data(env), dtor_name, (const char*)a,
+ enif_sizeof_resource(a));
}
/* {resource_type, Ix|null, ErlNifResourceFlags in, "TypeName", dtor(A|B|null), ErlNifResourceFlags out}*/
static void open_resource_type(ErlNifEnv* env, ERL_NIF_TERM op_tpl)
{
- NifModPrivData* data = enif_priv_data(env);
+ NifModPrivData* data = priv_data(env);
const ERL_NIF_TERM* arr;
int arity;
char rt_name[30];
- union { enum ErlNifResourceFlags e; int i; } flags, exp_res, got_res;
+ union { ErlNifResourceFlags e; int i; } flags, exp_res, got_res;
unsigned ix;
ErlNifResourceDtor* dtor;
ErlNifResourceType* got_ptr;
CHECK(enif_get_tuple(env, op_tpl, &arity, &arr));
CHECK(arity == 6);
- CHECK(enif_is_identical(env, arr[0], am_resource_type));
+ CHECK(enif_is_identical(arr[0], am_resource_type));
CHECK(enif_get_int(env, arr[2], &flags.i));
CHECK(enif_get_string(env, arr[3], rt_name, sizeof(rt_name), ERL_NIF_LATIN1) > 0);
CHECK(enif_get_int(env, arr[5], &exp_res.i));
- if (enif_is_identical(env, arr[4], am_null)) {
+ if (enif_is_identical(arr[4], am_null)) {
dtor = NULL;
}
- else if (enif_is_identical(env, arr[4], am_resource_dtor_A)) {
+ else if (enif_is_identical(arr[4], am_resource_dtor_A)) {
dtor = resource_dtor_A;
}
else {
- CHECK(enif_is_identical(env, arr[4], am_resource_dtor_B));
+ CHECK(enif_is_identical(arr[4], am_resource_dtor_B));
dtor = resource_dtor_B;
}
- got_ptr = enif_open_resource_type(env, rt_name, dtor,
+ got_ptr = enif_open_resource_type(env, NULL, rt_name, dtor,
flags.e, &got_res.e);
if (enif_get_uint(env, arr[1], &ix) && ix < RT_MAX && got_ptr != NULL) {
data->rt_arr[ix] = got_ptr;
}
else {
- CHECK(enif_is_identical(env, arr[1], am_null));
+ CHECK(enif_is_identical(arr[1], am_null));
CHECK(got_ptr == NULL);
}
CHECK(got_res.e == exp_res.e);
@@ -144,7 +149,7 @@ static void open_resource_type(ErlNifEnv* env, ERL_NIF_TERM op_tpl)
static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info)
{
- NifModPrivData* data = enif_priv_data(env);
+ NifModPrivData* data = priv_data(env);
ERL_NIF_TERM head, tail;
unsigned ix;
for (ix=0; ix<RT_MAX; ix++) {
@@ -158,17 +163,18 @@ static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info)
CHECK(enif_is_empty_list(env, head));
}
-static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info)
{
NifModPrivData* data;
init(env);
- data = enif_alloc(env, sizeof(NifModPrivData));
+ data = (NifModPrivData*) enif_alloc(sizeof(NifModPrivData));
CHECK(data != NULL);
- *priv_data = data;
+ *priv = data;
data->mtx = enif_mutex_create("nif_mod_priv_data");
data->ref_cnt = 1;
data->call_history = NULL;
+
add_call(env, data, "load");
do_load_info(env, load_info);
@@ -176,39 +182,35 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
return 0;
}
-static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+static int reload(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info)
{
+ NifModPrivData* data = (NifModPrivData*) *priv;
init(env);
- add_call(env, *priv_data, "reload");
+ add_call(env, data, "reload");
do_load_info(env, load_info);
return 0;
}
-static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info)
+static int upgrade(ErlNifEnv* env, void** priv, void** old_priv_data, ERL_NIF_TERM load_info)
{
- NifModPrivData* data = *old_priv_data;
+ NifModPrivData* data = (NifModPrivData*) *old_priv_data;
init(env);
add_call(env, data, "upgrade");
data->ref_cnt++;
- *priv_data = *old_priv_data;
+ *priv = *old_priv_data;
do_load_info(env, load_info);
return 0;
}
-static void unload(ErlNifEnv* env, void* priv_data)
+static void unload(ErlNifEnv* env, void* priv)
{
- NifModPrivData* data = priv_data;
+ NifModPrivData* data = (NifModPrivData*) priv;
+ int is_last;
add_call(env, data, "unload");
- enif_mutex_lock(data->mtx);
- if (--data->ref_cnt == 0) {
- enif_mutex_unlock(data->mtx);
- enif_mutex_destroy(data->mtx);
- enif_free(env, data);
- }
- enif_mutex_unlock(data->mtx);
+ NifModPrivData_release(data);
}
static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -220,12 +222,12 @@ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ADD_CALL("get_priv_data_ptr");
- return enif_make_ulong(env, (unsigned long)enif_priv_data(env));
+ return enif_make_ulong(env, (unsigned long)priv_data(env));
}
static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- NifModPrivData* data = (NifModPrivData*) enif_priv_data(env);
+ NifModPrivData* data = priv_data(env);
ErlNifBinary ibin;
char* a;
ERL_NIF_TERM ret;
@@ -234,22 +236,22 @@ static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TE
|| !enif_inspect_binary(env, argv[1], &ibin)) {
return enif_make_badarg(env);
}
- a = enif_alloc_resource(env, data->rt_arr[ix], ibin.size);
+ a = (char*) enif_alloc_resource(data->rt_arr[ix], ibin.size);
memcpy(a, ibin.data, ibin.size);
ret = enif_make_resource(env, a);
- enif_release_resource(env, a);
+ enif_release_resource(a);
return ret;
}
static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- NifModPrivData* data = (NifModPrivData*) enif_priv_data(env);
+ NifModPrivData* data = priv_data(env);
ErlNifBinary obin;
unsigned ix;
void* a;
if (!enif_get_uint(env, argv[0], &ix) || ix >= RT_MAX
|| !enif_get_resource(env, argv[1], data->rt_arr[ix], &a)
- || !enif_alloc_binary(env, enif_sizeof_resource(env, a), &obin)) {
+ || !enif_alloc_binary(enif_sizeof_resource(a), &obin)) {
return enif_make_badarg(env);
}
memcpy(obin.data, a, obin.size);
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.h b/erts/emulator/test/nif_SUITE_data/nif_mod.h
index 0eaf91d6e1..cd0ecf4b54 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.h
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.h
@@ -20,3 +20,15 @@ typedef struct
ErlNifResourceType* rt_arr[RT_MAX];
}NifModPrivData;
+#define NifModPrivData_release(NMPD) \
+ do { \
+ int is_last; \
+ enif_mutex_lock((NMPD)->mtx); \
+ is_last = (--(NMPD)->ref_cnt == 0); \
+ enif_mutex_unlock((NMPD)->mtx); \
+ if (is_last) { \
+ enif_mutex_destroy((NMPD)->mtx); \
+ enif_free((NMPD)); \
+ } \
+ }while (0)
+
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index eb69bf917b..66aff307a3 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -88,7 +88,7 @@
otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1,
mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1,
exit_status_multi_scheduling_block/1, ports/1,
- spawn_driver/1,spawn_executable/1,
+ spawn_driver/1, spawn_executable/1, close_deaf_port/1,
unregister_name/1]).
-export([]).
@@ -113,7 +113,7 @@ all(suite) ->
otp_3906, otp_4389, win_massive, mix_up_ports,
otp_5112, otp_5119,
exit_status_multi_scheduling_block,
- ports, spawn_driver, spawn_executable,
+ ports, spawn_driver, spawn_executable, close_deaf_port,
unregister_name
].
@@ -2293,3 +2293,12 @@ load_driver(Dir, Driver) ->
io:format("~s\n", [erl_ddll:format_error(Error)]),
Res
end.
+
+
+close_deaf_port(doc) -> ["Send data to port program that does not read it, then close port."];
+close_deaf_port(suite) -> [];
+close_deaf_port(Config) when is_list(Config) ->
+ Port = open_port({spawn,"sleep 999999"},[]),
+ erlang:port_command(Port,"Hello, can you hear me!?!?"),
+ port_close(Port),
+ ok.
diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl
new file mode 100644
index 0000000000..40ebf2bd21
--- /dev/null
+++ b/erts/emulator/test/receive_SUITE.erl
@@ -0,0 +1,113 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 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
+%% 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(receive_SUITE).
+
+%% Tests receive after.
+
+-include("test_server.hrl").
+
+-export([all/1,
+ call_with_huge_message_queue/1,receive_in_between/1]).
+
+-export([init_per_testcase/2,fin_per_testcase/2]).
+
+all(suite) ->
+ [call_with_huge_message_queue,receive_in_between].
+
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ Dog=?t:timetrap(?t:minutes(3)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+call_with_huge_message_queue(Config) when is_list(Config) ->
+ ?line Pid = spawn_link(fun echo_loop/0),
+
+ ?line {Time,ok} = tc(fun() -> calls(10, Pid) end),
+
+ ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)],
+ erlang:garbage_collect(),
+ ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end),
+ io:format("Time for empty message queue: ~p", [Time]),
+ io:format("Time for huge message queue: ~p", [NewTime]),
+
+ case (NewTime+1) / (Time+1) of
+ Q when Q < 10 ->
+ ok;
+ Q ->
+ io:format("Q = ~p", [Q]),
+ ?line ?t:fail()
+ end,
+ ok.
+
+calls(0, _) -> ok;
+calls(N, Pid) ->
+ {ok,{ultimate_answer,42}} = call(Pid, {ultimate_answer,42}),
+ calls(N-1, Pid).
+
+call(Pid, Msg) ->
+ Mref = erlang:monitor(process, Pid),
+ Pid ! {Mref,{self(),Msg}},
+ receive
+ {Mref, Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ {ok, Reply};
+ {'DOWN', Mref, _, _, Reason} ->
+ exit(Reason)
+ end.
+
+receive_in_between(Config) when is_list(Config) ->
+ ?line Pid = spawn_link(fun echo_loop/0),
+ ?line [{ok,{a,b}} = call2(Pid, {a,b}) || _ <- lists:seq(1, 100000)],
+ ok.
+
+call2(Pid, Msg) ->
+ self() ! dummy,
+ Mref = erlang:monitor(process, Pid),
+ Pid ! {Mref,{self(),Msg}},
+ receive_one(),
+ receive
+ {Mref,Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ {ok,Reply};
+ {'DOWN',Mref,_,_,Reason} ->
+ exit(Reason)
+ end.
+
+receive_one() ->
+ receive
+ dummy -> ok
+ end.
+
+%%%
+%%% Common helpers.
+%%%
+
+echo_loop() ->
+ receive
+ {Ref,{Pid,Msg}} ->
+ Pid ! {Ref,Msg},
+ echo_loop()
+ end.
+
+tc(Fun) ->
+ timer:tc(erlang, apply, [Fun,[]]).
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index c9101b77c2..ab727b7cb1 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -902,7 +902,8 @@ scheduler_suspend_test(Config, Schedulers) ->
?line [SState] = mcall(Node, [fun () ->
erlang:system_info(schedulers_state)
end]),
- ?line {Sched, _, _} = SState,
+ ?line ?t:format("SState=~p~n", [SState]),
+ ?line {Sched, SchedOnln, _SchedAvail} = SState,
?line true = is_integer(Sched),
?line [ok] = mcall(Node, [fun () -> sst0_loop(300) end]),
?line [ok] = mcall(Node, [fun () -> sst1_loop(300) end]),
@@ -914,6 +915,14 @@ scheduler_suspend_test(Config, Schedulers) ->
fun () -> sst2_loop(200) end,
fun () -> sst3_loop(Sched, 200) end]),
?line [SState] = mcall(Node, [fun () ->
+ case Sched == SchedOnln of
+ false ->
+ Sched = erlang:system_flag(
+ schedulers_online,
+ SchedOnln);
+ true ->
+ ok
+ end,
erlang:system_info(schedulers_state)
end]),
?line stop_node(Node),