aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/beam')
-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
37 files changed, 4133 insertions, 542 deletions
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;