aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2010-05-20 10:01:54 +0000
committerErlang/OTP <[email protected]>2010-05-20 10:01:54 +0000
commitc0895d14994c5e98b1171b0174c70a0244d52f86 (patch)
tree9cd67f70ed7898bed9460f73d493ac6064213bd8
parentdb16e96833094bf3b13d562388b3de02bba8d73d (diff)
parent97ab480df55cf574ab42a87b6927ef5bba83000e (diff)
downloadotp-c0895d14994c5e98b1171b0174c70a0244d52f86.tar.gz
otp-c0895d14994c5e98b1171b0174c70a0244d52f86.tar.bz2
otp-c0895d14994c5e98b1171b0174c70a0244d52f86.zip
Merge branch 'pan/otp_8217_binary' into dev
* pan/otp_8217_binary: Add documentation for binary module Add more tests and make some go easier on small systems Correct Boyer More and trapping for longest_common_suffix Add longer timetrap to testcases and add binary to app file Add guard BIFs binary_part/2,3 Add binary:{encode,decode}_unsigned({1,2} Add referenced_byte_size/1 Add binary:list_to_bin/1 and binary:copy/1,2 Add bin_to_list/{1,2,3} Add binary:longest_common_prefix/longest_common_suffix Add binary:part to erl_bif_binary.c Move binary module bif's to erl_bif_binary.c Count reductions for process even when not trapping Add random compare testcase Teach BIF's binary:match/matches interrupting/restarting Teach binary.c the semantics to take longest instead of shortest match Initial commit of the binary EEP OTP-8217 Implement EEP31 The module binary from EEP31 (and EEP9) is implemented.
-rw-r--r--erts/doc/src/erlang.xml53
-rw-r--r--erts/emulator/Makefile.in3
-rw-r--r--erts/emulator/beam/atom.names9
-rw-r--r--erts/emulator/beam/beam_emu.c79
-rw-r--r--erts/emulator/beam/beam_load.c86
-rw-r--r--erts/emulator/beam/bif.tab34
-rw-r--r--erts/emulator/beam/binary.c57
-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.c11
-rw-r--r--erts/emulator/beam/erl_binary.h25
-rw-r--r--erts/emulator/beam/erl_init.c1
-rw-r--r--erts/emulator/beam/erl_nif.c4
-rw-r--r--erts/emulator/beam/erl_vm.h3
-rw-r--r--erts/emulator/beam/global.h6
-rw-r--r--erts/emulator/beam/ops.tab33
-rw-r--r--erts/emulator/test/Makefile3
-rw-r--r--erts/emulator/test/guard_SUITE.erl179
-rw-r--r--lib/compiler/src/beam_asm.erl3
-rw-r--r--lib/compiler/src/beam_disasm.erl7
-rw-r--r--lib/compiler/src/erl_bifs.erl12
-rw-r--r--lib/compiler/src/genop.tab1
-rw-r--r--lib/compiler/test/guard_SUITE.erl144
-rw-r--r--lib/stdlib/doc/src/Makefile11
-rw-r--r--lib/stdlib/doc/src/binary.xml729
-rw-r--r--lib/stdlib/doc/src/ref_man.xml7
-rw-r--r--lib/stdlib/src/Makefile1
-rw-r--r--lib/stdlib/src/binary.erl177
-rw-r--r--lib/stdlib/src/erl_internal.erl14
-rw-r--r--lib/stdlib/src/stdlib.app.src11
-rw-r--r--lib/stdlib/test/Makefile2
-rw-r--r--lib/stdlib/test/binary_module_SUITE.erl1323
-rw-r--r--lib/stdlib/test/binref.erl588
34 files changed, 6496 insertions, 88 deletions
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index cd9bb85f5c..e90160dfd7 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -253,6 +253,54 @@ iolist() = [char() | binary() | iolist()]
</desc>
</func>
<func>
+ <name>binary_part(Subject, PosLen) -> binary()</name>
+ <fsummary>Extracts a part of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>PosLen = {Start,Length}</v>
+ <v>Start = int()</v>
+ <v>Length = int()</v>
+ </type>
+ <desc>
+ <p>Extracts the part of the binary described by <c>PosLen</c>.</p>
+
+ <p>Negative length can be used to extract bytes at the end of a binary:</p>
+
+<code>
+1> Bin = &lt;&lt;1,2,3,4,5,6,7,8,9,10&gt;&gt;.
+2> binary_part(Bin,{byte_size(Bin), -5)).
+&lt;&lt;6,7,8,9,10&gt;&gt;
+</code>
+
+ <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception is raised.</p>
+
+ <p><c>Start</c> is zero-based, i.e:</p>
+<code>
+1> Bin = &lt;&lt;1,2,3&gt;&gt;
+2> binary_part(Bin,{0,2}).
+&lt;&lt;1,2&gt;&gt;
+</code>
+
+ <p>See the STDLIB module <c>binary</c> for details about the <c>PosLen</c> semantics.</p>
+
+ <p>Allowed in guard tests.</p>
+ </desc>
+ </func>
+ <func>
+ <name>binary_part(Subject, Start, Length) -> binary()</name>
+ <fsummary>Extracts a part of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Start = int()</v>
+ <v>Length = int()</v>
+ </type>
+ <desc>
+ <p>The same as <c>binary_part(Subject, {Pos, Len})</c>.</p>
+
+ <p>Allowed in guard tests.</p>
+ </desc>
+ </func>
+ <func>
<name>binary_to_atom(Binary, Encoding) -> atom()</name>
<fsummary>Convert from text representation to an atom</fsummary>
<type>
@@ -318,6 +366,11 @@ iolist() = [char() | binary() | iolist()]
corresponding to the bytes from position <c>Start</c> to
position <c>Stop</c> in <c>Binary</c>. Positions in the
binary are numbered starting from 1.</p>
+
+ <note><p>This functions indexing style of using one-based indices for
+ binaries is deprecated. New code should use the functions in
+ the STDLIB module <c>binary</c> instead. They consequently
+ use the same (zero-based) style of indexing.</p></note>
</desc>
</func>
<func>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 9f10a0ffaa..d767194d4d 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -735,7 +735,8 @@ RUN_OBJS = \
$(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \
$(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \
$(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \
- $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o
+ $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \
+ $(OBJDIR)/erl_bif_binary.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
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 ee8ba54cb8..f0b04535dd 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -2026,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.
*/
@@ -4986,6 +5061,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..597f604e22 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,
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index b6fa06354a..9feb302a3d 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -760,6 +760,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/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..8071d94d07
--- /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 aither Boyer-More 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 alocated 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-More.
+ */
+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 conter, 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 parents
+ failure function until you find a similar transition
+ funtion to this childs */
+ 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 More - most obviously implemented more or less exactly as
+ * Christian Charras and Thierry Lecroq describes 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,
+ thats not to 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 is seldom many iterations involved in doing this, so the
+ * problem of long-running-bif's 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-More 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..de60ca49fa 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -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_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_init.c b/erts/emulator/beam/erl_init.c
index e63ec8a3cc..f2e71ae98d 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);
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 2790020117..cee4df72a2 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -250,7 +250,7 @@ int enif_is_ref(ErlNifEnv* env, ERL_NIF_TERM 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 +260,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;
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 235bd7931d..eeeeb7ccfd 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)
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index fbb40e4202..a7990e1799 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1576,6 +1576,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 +1709,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);
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 49280a60e0..d6feef3fb9 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -1390,33 +1390,50 @@ 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
#
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 2424fedbed..97b94c466f 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -118,7 +118,8 @@ NO_OPT= bs_bincomp \
bs_match_int \
bs_match_tail \
bs_match_misc \
- bs_utf
+ bs_utf \
+ guard
NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE)
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index 23482a20d7..8fef36dfaf 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -1,33 +1,34 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(guard_SUITE).
-export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1,
- type_tests/1]).
+ type_tests/1,guard_bif_binary_part/1]).
-include("test_server.hrl").
-export([init/3]).
-import(lists, [member/2]).
-all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests].
+all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs,
+ type_tests, guard_bif_binary_part].
bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly.";
bad_arith(Config) when is_list(Config) ->
@@ -136,6 +137,170 @@ init(Fun, Args, Filler) ->
dummy(_) ->
ok.
+-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
+mask_error({'EXIT',{Err,_}}) ->
+ Err;
+mask_error(Else) ->
+ Else.
+
+guard_bif_binary_part(doc) ->
+ ["Test the binary_part/2,3 guard BIF's extensively"];
+guard_bif_binary_part(Config) when is_list(Config) ->
+ %% Overflow tests that need to be unoptimized
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ -16#7FFFFFFFFFFFFFFF-1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ 16#7FFFFFFFFFFFFFFF})),
+ F = fun(X) ->
+ Master = self(),
+ {Pid,Ref} = spawn_monitor( fun() ->
+ A = lists:duplicate(X,a),
+ B = [do_binary_part_guard() | A],
+ Master ! {self(),hd(B)},
+ ok
+ end),
+ receive
+ {Pid,ok} ->
+ erlang:demonitor(Ref,[flush]),
+ ok;
+ Error ->
+ Error
+ end
+ end,
+ [ ok = F(N) || N <- lists:seq(1,10000) ],
+ ok.
+
+
+do_binary_part_guard() ->
+ ?line 1 = bptest(<<1,2,3>>),
+ ?line 2 = bptest(<<2,1,3>>),
+ ?line error = bptest(<<1>>),
+ ?line error = bptest(<<>>),
+ ?line error = bptest(apa),
+ ?line 3 = bptest(<<2,3,3>>),
+ % With one variable (pos)
+ ?line 1 = bptest(<<1,2,3>>,1),
+ ?line 2 = bptest(<<2,1,3>>,1),
+ ?line error = bptest(<<1>>,1),
+ ?line error = bptest(<<>>,1),
+ ?line error = bptest(apa,1),
+ ?line 3 = bptest(<<2,3,3>>,1),
+ % With one variable (length)
+ ?line 1 = bptesty(<<1,2,3>>,1),
+ ?line 2 = bptesty(<<2,1,3>>,1),
+ ?line error = bptesty(<<1>>,1),
+ ?line error = bptesty(<<>>,1),
+ ?line error = bptesty(apa,1),
+ ?line 3 = bptesty(<<2,3,3>>,2),
+ % With one variable (whole tuple)
+ ?line 1 = bptestx(<<1,2,3>>,{1,1}),
+ ?line 2 = bptestx(<<2,1,3>>,{1,1}),
+ ?line error = bptestx(<<1>>,{1,1}),
+ ?line error = bptestx(<<>>,{1,1}),
+ ?line error = bptestx(apa,{1,1}),
+ ?line 3 = bptestx(<<2,3,3>>,{1,2}),
+ % With two variables
+ ?line 1 = bptest(<<1,2,3>>,1,1),
+ ?line 2 = bptest(<<2,1,3>>,1,1),
+ ?line error = bptest(<<1>>,1,1),
+ ?line error = bptest(<<>>,1,1),
+ ?line error = bptest(apa,1,1),
+ ?line 3 = bptest(<<2,3,3>>,1,2),
+ % Direct (autoimported) call, these will be evaluated by the compiler...
+ ?line <<2>> = binary_part(<<1,2,3>>,1,1),
+ ?line <<1>> = binary_part(<<2,1,3>>,1,1),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)),
+ ?line <<3,3>> = binary_part(<<2,3,3>>,1,2),
+ % Direct call through apply
+ ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
+ ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
+ ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
+ % Constant propagation
+ ?line Bin = <<1,2,3>>,
+ ?line ok = if
+ binary_part(Bin,1,1) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ?line ok = if
+ binary_part(Bin,{1,1}) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ok.
+
+
+bptest(B) when length(B) =:= 1337 ->
+ 1;
+bptest(B) when binary_part(B,{1,1}) =:= <<2>> ->
+ 1;
+bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> ->
+ 2;
+bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> ->
+ 3;
+bptest(_) ->
+ error.
+
+bptest(B,A) when length(B) =:= A ->
+ 1;
+bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> ->
+ 1;
+bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> ->
+ 2;
+bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> ->
+ 3;
+bptest(_,_) ->
+ error.
+
+bptestx(B,A) when length(B) =:= A ->
+ 1;
+bptestx(B,A) when binary_part(B,A) =:= <<2>> ->
+ 1;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> ->
+ 2;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> ->
+ 3;
+bptestx(_,_) ->
+ error.
+
+bptesty(B,A) when length(B) =:= A ->
+ 1;
+bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> ->
+ 1;
+bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> ->
+ 2;
+bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> ->
+ 3;
+bptesty(_,_) ->
+ error.
+
+bptest(B,A,_C) when length(B) =:= A ->
+ 1;
+bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> ->
+ 1;
+bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> ->
+ 2;
+bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> ->
+ 3;
+bptest(_,_,_) ->
+ error.
+
+
guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments).";
guard_bifs(Config) when is_list(Config) ->
?line Big = -237849247829874297658726487367328971246284736473821617265433,
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index 115c228b0a..89d64834cf 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -261,7 +261,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) ->
Arity = length(Args),
BifOp = case Arity of
1 -> gc_bif1;
- 2 -> gc_bif2
+ 2 -> gc_bif2;
+ 3 -> gc_bif3
end,
encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict);
make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) ->
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 9571f817e3..920ce07396 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1004,6 +1004,13 @@ resolve_inst({gc_bif2,Args},Imports,_,_) ->
[F,Live,Bif,A1,A2,Reg] = resolve_args(Args),
{extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
{gc_bif,BifName,F,Live,[A1,A2],Reg};
+%%
+%% New instruction in R14, gc_bif with 3 arguments
+%%
+resolve_inst({gc_bif3,Args},Imports,_,_) ->
+ [F,Live,Bif,A1,A2,A3,Reg] = resolve_args(Args),
+ {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
+ {gc_bif,BifName,F,Live,[A1,A2,A3],Reg};
%%
%% New instructions for creating non-byte aligned binaries.
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index e87bb276de..f8128702dd 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -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%
%%
%% Purpose: Information about the Erlang built-in functions.
@@ -65,6 +65,8 @@ is_pure(erlang, 'xor', 2) -> true;
is_pure(erlang, abs, 1) -> true;
is_pure(erlang, atom_to_binary, 2) -> true;
is_pure(erlang, atom_to_list, 1) -> true;
+is_pure(erlang, binary_part, 2) -> true;
+is_pure(erlang, binary_part, 3) -> true;
is_pure(erlang, binary_to_atom, 2) -> true;
is_pure(erlang, binary_to_list, 1) -> true;
is_pure(erlang, binary_to_list, 3) -> true;
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index b57508ea8e..d7e344b019 100644
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -279,3 +279,4 @@ BEAM_FORMAT_NUMBER=0
150: recv_mark/1
151: recv_set/1
+152: gc_bif3/7
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index f3960b28c3..aa1b3b16dc 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -31,7 +31,7 @@
t_is_boolean/1,is_function_2/1,
tricky/1,rel_ops/1,literal_type_tests/1,
basic_andalso_orelse/1,traverse_dcd/1,
- check_qlc_hrl/1,andalso_semi/1,tuple_size/1]).
+ check_qlc_hrl/1,andalso_semi/1,tuple_size/1,binary_part/1]).
all(suite) ->
test_lib:recompile(?MODULE),
@@ -43,7 +43,7 @@ all(suite) ->
build_in_guard,old_guard_tests,gbif,
t_is_boolean,is_function_2,tricky,rel_ops,literal_type_tests,
basic_andalso_orelse,traverse_dcd,check_qlc_hrl,andalso_semi,
- tuple_size].
+ tuple_size,binary_part].
misc(Config) when is_list(Config) ->
?line 42 = case id(42) of
@@ -1362,6 +1362,146 @@ ludicrous_tuple_size(T)
when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok;
ludicrous_tuple_size(_) -> error.
+%%
+%% The binary_part/2,3 guard BIFs
+%%
+-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
+mask_error({'EXIT',{Err,_}}) ->
+ Err;
+mask_error(Else) ->
+ Else.
+
+binary_part(doc) ->
+ ["Tests the binary_part/2,3 guard (GC) bif's"];
+binary_part(Config) when is_list(Config) ->
+ %% This is more or less a copy of what the guard_SUITE in emulator
+ %% does to cover the guard bif's
+ ?line 1 = bptest(<<1,2,3>>),
+ ?line 2 = bptest(<<2,1,3>>),
+ ?line error = bptest(<<1>>),
+ ?line error = bptest(<<>>),
+ ?line error = bptest(apa),
+ ?line 3 = bptest(<<2,3,3>>),
+ % With one variable (pos)
+ ?line 1 = bptest(<<1,2,3>>,1),
+ ?line 2 = bptest(<<2,1,3>>,1),
+ ?line error = bptest(<<1>>,1),
+ ?line error = bptest(<<>>,1),
+ ?line error = bptest(apa,1),
+ ?line 3 = bptest(<<2,3,3>>,1),
+ % With one variable (length)
+ ?line 1 = bptesty(<<1,2,3>>,1),
+ ?line 2 = bptesty(<<2,1,3>>,1),
+ ?line error = bptesty(<<1>>,1),
+ ?line error = bptesty(<<>>,1),
+ ?line error = bptesty(apa,1),
+ ?line 3 = bptesty(<<2,3,3>>,2),
+ % With one variable (whole tuple)
+ ?line 1 = bptestx(<<1,2,3>>,{1,1}),
+ ?line 2 = bptestx(<<2,1,3>>,{1,1}),
+ ?line error = bptestx(<<1>>,{1,1}),
+ ?line error = bptestx(<<>>,{1,1}),
+ ?line error = bptestx(apa,{1,1}),
+ ?line 3 = bptestx(<<2,3,3>>,{1,2}),
+ % With two variables
+ ?line 1 = bptest(<<1,2,3>>,1,1),
+ ?line 2 = bptest(<<2,1,3>>,1,1),
+ ?line error = bptest(<<1>>,1,1),
+ ?line error = bptest(<<>>,1,1),
+ ?line error = bptest(apa,1,1),
+ ?line 3 = bptest(<<2,3,3>>,1,2),
+ % Direct (autoimported) call, these will be evaluated by the compiler...
+ ?line <<2>> = binary_part(<<1,2,3>>,1,1),
+ ?line <<1>> = binary_part(<<2,1,3>>,1,1),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)),
+ ?line <<3,3>> = binary_part(<<2,3,3>>,1,2),
+ % Direct call through apply
+ ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
+ ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
+ ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
+ % Constant propagation
+ ?line Bin = <<1,2,3>>,
+ ?line ok = if
+ binary_part(Bin,1,1) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ?line ok = if
+ binary_part(Bin,{1,1}) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ok.
+
+
+bptest(B) when length(B) =:= 1337 ->
+ 1;
+bptest(B) when binary_part(B,{1,1}) =:= <<2>> ->
+ 1;
+bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> ->
+ 2;
+bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> ->
+ 3;
+bptest(_) ->
+ error.
+
+bptest(B,A) when length(B) =:= A ->
+ 1;
+bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> ->
+ 1;
+bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> ->
+ 2;
+bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> ->
+ 3;
+bptest(_,_) ->
+ error.
+
+bptestx(B,A) when length(B) =:= A ->
+ 1;
+bptestx(B,A) when binary_part(B,A) =:= <<2>> ->
+ 1;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> ->
+ 2;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> ->
+ 3;
+bptestx(_,_) ->
+ error.
+
+bptesty(B,A) when length(B) =:= A ->
+ 1;
+bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> ->
+ 1;
+bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> ->
+ 2;
+bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> ->
+ 3;
+bptesty(_,_) ->
+ error.
+
+bptest(B,A,_C) when length(B) =:= A ->
+ 1;
+bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> ->
+ 1;
+bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> ->
+ 2;
+bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> ->
+ 3;
+bptest(_,_,_) ->
+ error.
+
+
+
%% Call this function to turn off constant propagation.
id(I) -> I.
diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile
index 13b9b2ff18..b558697d63 100644
--- a/lib/stdlib/doc/src/Makefile
+++ b/lib/stdlib/doc/src/Makefile
@@ -1,19 +1,19 @@
#
# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2009. All Rights Reserved.
-#
+#
+# Copyright Ericsson AB 1997-2010. All Rights Reserved.
+#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
# compliance with the License. You should have received a copy of the
# Erlang Public License along with this software. If not, it can be
# retrieved online at http://www.erlang.org/.
-#
+#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and limitations
# under the License.
-#
+#
# %CopyrightEnd%
#
include $(ERL_TOP)/make/target.mk
@@ -40,6 +40,7 @@ XML_REF3_FILES = \
array.xml \
base64.xml \
beam_lib.xml \
+ binary.xml \
c.xml \
calendar.xml \
dets.xml \
diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml
new file mode 100644
index 0000000000..05ec4406c6
--- /dev/null
+++ b/lib/stdlib/doc/src/binary.xml
@@ -0,0 +1,729 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2009</year>
+ <year>2010</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ 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 on line 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.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>binary</title>
+ <prepared>Patrik Nyblom</prepared>
+ <responsible>Kenneth Lundin</responsible>
+ <docno>1</docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2010-05-05</date>
+ <rev>A</rev>
+ <file>binary.xml</file>
+ </header>
+ <module>binary</module>
+ <modulesummary>Library for handling binary data</modulesummary>
+ <description>
+
+ <p>This module contains functions for manipulating byte-oriented
+ binaries. Although the majority of functions could be implemented
+ using bit-syntax, the functions in this library are highly
+ optimized and are expected to either execute faster or consume
+ less memory (or both) than a counterpart written in pure Erlang.</p>
+
+ <p>The module is implemented according to the EEP (Erlang Enhancement Proposal) 31.</p>
+
+ <note>
+ <p>
+ The library handles byte-oriented data. Bitstrings that are not
+ binaries (does not contain whole octets of bits) will result in a <c>badarg</c>
+ exception being thrown from any of the functions in this
+ module.
+ </p>
+ </note>
+
+
+ </description>
+ <section>
+ <title>DATA TYPES</title>
+ <code type="none">
+ cp()
+ - Opaque data-type representing a compiled search-pattern. Guaranteed to be a tuple()
+ to allow programs to distinguish it from non precompiled search patterns.
+ </code>
+ <code type="none">
+ part() = {Start,Length}
+ Start = int()
+ Length = int()
+ - A representaion of a part (or range) in a binary. Start is a
+ zero-based offset into a binary() and Length is the length of
+ that part. As input to functions in this module, a reverse
+ part specification is allowed, constructed with a negative
+ Length, so that the part of the binary begins at Start +
+ Length and is -Length long. This is useful for referencing the
+ last N bytes of a binary as {size(Binary), -N}. The functions
+ in this module always return part()'s with positive Length.
+ </code>
+ </section>
+ <funcs>
+ <func>
+ <name>at(Subject, Pos) -> int()</name>
+ <fsummary>Returns the byte at a specific position in a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pos = int() >= 0</v>
+ </type>
+ <desc>
+
+ <p>Returns the byte at position <c>Pos</c> (zero-based) in the binary
+ <c>Subject</c> as an integer. If <c>Pos</c> &gt;= <c>byte_size(Subject)</c>,
+ a <c>badarg</c>
+ exception is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>bin_to_list(Subject) -> list()</name>
+ <fsummary>Convert a binary to a list of integers</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ </type>
+ <desc>
+ <p>The same as <c>bin_to_list(Subject,{0,byte_size(Subject)})</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>bin_to_list(Subject, PosLen) -> list()</name>
+ <fsummary>Convert a binary to a list of integers</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>PosLen = part()</v>
+ </type>
+ <desc>
+
+ <p>Converts <c>Subject</c> to a list of <c>int()</c>s, each representing
+ the value of one byte. The <c>part()</c> denotes which part of the
+ <c>binary()</c> to convert. Example:</p>
+
+<code>
+1> binary:bin_to_list(&lt;&lt;"erlang"&gt;&gt;,{1,3}).
+"rla"
+%% or [114,108,97] in list notation.
+</code>
+ <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception is raised.</p>
+ </desc>
+ </func>
+ <func>
+ <name>bin_to_list(Subject, Pos, Len) -> list()</name>
+ <fsummary>Convert a binary to a list of integers</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pos = int()</v>
+ <v>Len = int()</v>
+ </type>
+ <desc>
+ <p>The same as<c> bin_to_list(Subject,{Pos,Len})</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>compile_pattern(Pattern) -> cp()</name>
+ <fsummary>Pre-compiles a binary search pattern</fsummary>
+ <type>
+ <v>Pattern = binary() | [ binary() ]</v>
+ </type>
+ <desc>
+
+ <p>Builds an internal structure representing a compilation of a
+ search-pattern, later to be used in the <seealso marker="#match-3">match/3</seealso>,
+ <seealso marker="#matches-3">matches/3</seealso>,
+ <seealso marker="#split-3">split/3</seealso> or
+ <seealso marker="#replace-4">replace/4</seealso>
+ functions. The <c>cp()</c> returned is guaranteed to be a
+ <c>tuple()</c> to allow programs to distinguish it from non
+ pre-compiled search patterns</p>
+
+ <p>When a list of binaries is given, it denotes a set of
+ alternative binaries to search for. I.e if
+ <c>[&lt;&lt;"functional"&gt;&gt;,&lt;&lt;"programming"&gt;&gt;]</c>
+ is given as <c>Pattern</c>, this
+ means "either <c>&lt;&lt;"functional"&gt;&gt;</c> or
+ <c>&lt;&lt;"programming"&gt;&gt;</c>". The pattern is a set of
+ alternatives; when only a single binary is given, the set has
+ only one element. The order of alternatives in a pattern is not significant.</p>
+
+ <p>The list of binaries used for search alternatives shall be flat and proper.</p>
+
+ <p>If <c>Pattern</c> is not a binary or a flat proper list of binaries with length &gt; 0,
+ a <c>badarg</c> exception will be raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>copy(Subject) -> binary()</name>
+ <fsummary>Creates a duplicate of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ </type>
+ <desc>
+ <p>The same as <c>copy(Subject, 1)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>copy(Subject,N) -> binary()</name>
+ <fsummary>Duplicates a binary N times and creates a new</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>N = int() >= 0</v>
+ </type>
+ <desc>
+ <p>Creates a binary with the content of <c>Subject</c> duplicated <c>N</c> times.</p>
+
+ <p>This function will always create a new binary, even if <c>N =
+ 1</c>. By using <c>copy/1</c> on a binary referencing a larger binary, one
+ might free up the larger binary for garbage collection.</p>
+
+ <note>
+ <p>By deliberately copying a single binary to avoid referencing
+ a larger binary, one might, instead of freeing up the larger
+ binary for later garbage collection, create much more binary
+ data than needed. Sharing binary data is usually good. Only in
+ special cases, when small parts reference large binaries and the
+ large binaries are no longer used in any process, deliberate
+ copying might be a good idea.</p> </note>
+
+ <p>If <c>N</c> &lt; <c>0</c>, a <c>badarg</c> exception is raised.</p>
+ </desc>
+ </func>
+ <func>
+ <name>decode_unsigned(Subject) -> Unsigned</name>
+ <fsummary>Decode a whole binary into an integer of arbitrary size</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Unsigned = int() >= 0</v>
+ </type>
+ <desc>
+ <p>The same as <c>decode_unsigned(Subject,big)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>decode_unsigned(Subject, Endianess) -> Unsigned</name>
+ <fsummary>Decode a whole binary into an integer of arbitrary size</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Endianess = big | little</v>
+ <v>Unsigned = int() >= 0</v>
+ </type>
+ <desc>
+
+ <p>Converts the binary digit representation, in big or little
+ endian, of a positive integer in <c>Subject</c> to an Erlang <c>int()</c>.</p>
+
+ <p>Example:</p>
+
+ <code>
+1> binary:decode_unsigned(&lt;&lt;169,138,199&gt;&gt;,big).
+11111111
+ </code>
+ </desc>
+ </func>
+ <func>
+ <name>encode_unsigned(Unsigned) -> binary()</name>
+ <fsummary>Encodes an unsigned integer into the minimal binary</fsummary>
+ <type>
+ <v>Unsigned = int() >= 0</v>
+ </type>
+ <desc>
+ <p>The same as <c>encode_unsigned(Unsigned,big)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>encode_unsigned(Unsigned,Endianess) -> binary()</name>
+ <fsummary>Encodes an unsigned integer into the minimal binary</fsummary>
+ <type>
+ <v>Unsigned = int() >= 0</v>
+ <v>Endianess = big | little</v>
+ </type>
+ <desc>
+
+ <p>Converts a positive integer to the smallest possible
+ representation in a binary digit representation, either big
+ or little endian.</p>
+
+ <p>Example:</p>
+
+ <code>
+1> binary:encode_unsigned(11111111,big).
+&lt;&lt;169,138,199&gt;&gt;
+ </code>
+ </desc>
+ </func>
+ <func>
+ <name>first(Subject) -> int()</name>
+ <fsummary>Returns the first byte of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ </type>
+ <desc>
+
+ <p>Returns the first byte of the binary <c>Subject</c> as an integer. If the
+ size of <c>Subject</c> is zero, a <c>badarg</c> exception is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>last(Subject) -> int()</name>
+ <fsummary>Returns the last byte of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ </type>
+ <desc>
+
+ <p>Returns the last byte of the binary <c>Subject</c> as an integer. If the
+ size of <c>Subject</c> is zero, a <c>badarg</c> exception is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>list_to_bin(ByteList) -> binary()</name>
+ <fsummary>Convert a list of integers and binaries to a binary</fsummary>
+ <type>
+ <v>ByteList = iodata() (see module erlang)</v>
+ </type>
+ <desc>
+ <p>Works exactly as <c>erlang:list_to_binary/1</c>, added for completeness.</p>
+ </desc>
+ </func>
+ <func>
+ <name>longest_common_prefix(Binaries) -> int()</name>
+ <fsummary>Returns length of longest common prefix for a set of binaries</fsummary>
+ <type>
+ <v>Binaries = [ binary() ]</v>
+ </type>
+ <desc>
+
+ <p>Returns the length of the longest common prefix of the
+ binaries in the list <c>Binaries</c>. Example:</p>
+
+<code>
+1> binary:longest_common_prefix([&lt;&lt;"erlang"&gt;&gt;,&lt;&lt;"ergonomy"&gt;&gt;]).
+2
+2> binary:longest_common_prefix([&lt;&lt;"erlang"&gt;&gt;,&lt;&lt;"perl"&gt;&gt;]).
+0
+</code>
+
+ <p>If <c>Binaries</c> is not a flat list of binaries, a <c>badarg</c> exception is raised.</p>
+ </desc>
+ </func>
+ <func>
+ <name>longest_common_suffix(Binaries) -> int()</name>
+ <fsummary>Returns length of longest common suffix for a set of binaries</fsummary>
+ <type>
+ <v>Binaries = [ binary() ]</v>
+ </type>
+ <desc>
+
+ <p>Returns the length of the longest common suffix of the
+ binaries in the list <c>Binaries</c>. Example:</p>
+
+<code>
+1> binary:longest_common_suffix([&lt;&lt;"erlang"&gt;&gt;,&lt;&lt;"fang"&gt;&gt;]).
+3
+2> binary:longest_common_suffix([&lt;&lt;"erlang"&gt;&gt;,&lt;&lt;"perl"&gt;&gt;]).
+0
+</code>
+
+ <p>If <c>Binaries</c> is not a flat list of binaries, a <c>badarg</c> exception is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>match(Subject, Pattern) -> Found | <c>nomatch</c></name>
+ <fsummary>Searches for the first match of a pattern in a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Found = part()</v>
+ </type>
+ <desc>
+ <p>The same as <c>match(Subject, Pattern, [])</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>match(Subject,Pattern,Options) -> Found | <c>nomatch</c></name>
+ <fsummary>Searches for the first match of a pattern in a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Found = part()</v>
+ <v>Options = [ Option ]</v>
+ <v>Option = {scope, part()}</v>
+ </type>
+ <desc>
+
+ <p>Searches for the first occurrence of <c>Pattern</c> in <c>Subject</c> and
+ returns the position and length.</p>
+
+ <p>The function will return <c>{Pos,Length}</c> for the binary
+ in <c>Pattern</c> starting at the lowest position in
+ <c>Subject</c>, Example:</p>
+
+<code>
+1> binary:match(&lt;&lt;"abcde"&gt;&gt;, [&lt;&lt;"bcde"&gt;&gt;,&lt;&lt;"cd"&gt;&gt;],[]).
+{1,4}
+</code>
+
+ <p>Even though <c>&lt;&lt;"cd"&gt;&gt;</c> ends before
+ <c>&lt;&lt;"bcde"&gt;&gt;</c>, <c>&lt;&lt;"bcde"&gt;&gt;</c>
+ begins first and is therefore the first match. If two
+ overlapping matches begins at the same position, the longest is
+ returned.</p>
+
+ <p>Summary of the options:</p>
+
+ <taglist>
+ <tag>{scope, {Start, Length}}</tag>
+ <item><p>Only the given part is searched. Return values still have
+ offsets from the beginning of <c>Subject</c>. A negative <c>Length</c> is
+ allowed as described in the <c>TYPES</c> section of this manual.</p></item>
+ </taglist>
+
+ <p>If none of the strings in
+ <c>Pattern</c> is found, the atom <c>nomatch</c> is returned.</p>
+
+ <p>For a description of <c>Pattern</c>, see
+ <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p>
+
+ <p>If <c>{scope, {Start,Length}}</c> is given in the options
+ such that <c>Start</c> is larger than the size of
+ <c>Subject</c>, <c>Start + Length</c> is less than zero or
+ <c>Start + Length</c> is larger than the size of
+ <c>Subject</c>, a <c>badarg</c> exception is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>matches(Subject, Pattern) -> Found</name>
+ <fsummary>Searches for all matches of a pattern in a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Found = [ part() ] | []</v>
+ </type>
+ <desc>
+ <p>The same as <c>matches(Subject, Pattern, [])</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>matches(Subject,Pattern,Options) -> Found</name>
+ <fsummary>Searches for all matches of a pattern in a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Found = [ part() ] | []</v>
+ <v>Options = [ Option ]</v>
+ <v>Option = {scope, part()}</v>
+ </type>
+ <desc>
+
+ <p>Works like match, but the <c>Subject</c> is searched until
+ exhausted and a list of all non-overlapping parts matching
+ <c>Pattern</c> is returned (in order). </p>
+
+ <p>The first and longest match is preferred to a shorter,
+ which is illustrated by the following example:</p>
+
+<code>
+1> binary:matches(&lt;&lt;"abcde"&gt;&gt;,
+ [&lt;&lt;"bcde"&gt;&gt;,&lt;&lt;"bc"&gt;&gt;>,&lt;&lt;"de"&gt;&gt;],[]).
+[{1,4}]
+</code>
+
+ <p>The result shows that &lt;&lt;bcde"&gt;&gt; is selected instead of the
+ shorter match &lt;&lt;"bc"&gt;&gt; (which would have given raise to one
+ more match,&lt;&lt;"de"&gt;&gt;). This corresponds to the behavior of posix
+ regular expressions (and programs like awk), but is not
+ consistent with alternative matches in re (and Perl), where
+ instead lexical ordering in the search pattern selects which
+ string matches.</p>
+
+ <p>If none of the strings in pattern is found, an empty list is returned.</p>
+
+ <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso> and for a
+ description of available options, see <seealso marker="#match-3">match/3</seealso>.</p>
+
+ <p>If <c>{scope, {Start,Length}}</c> is given in the options such that
+ <c>Start</c> is larger than the size of <c>Subject</c>, <c>Start + Length</c> is
+ less than zero or <c>Start + Length</c> is larger than the size of
+ <c>Subject</c>, a <c>badarg</c> exception is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>part(Subject, PosLen) -> binary()</name>
+ <fsummary>Extracts a part of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>PosLen = part()</v>
+ </type>
+ <desc>
+
+ <p>Extracts the part of the binary <c>Subject</c> described by <c>PosLen</c>.</p>
+
+ <p>Negative length can be used to extract bytes at the end of a binary:</p>
+
+<code>
+1> Bin = &lt;&lt;1,2,3,4,5,6,7,8,9,10&gt;&gt;.
+2> binary:part(Bin,{byte_size(Bin), -5)).
+&lt;&lt;6,7,8,9,10&gt;&gt;
+</code>
+
+ <note>
+ <p><seealso marker="#part-2">part/2</seealso>and <seealso
+ marker="#part-3">part/3</seealso> are also available in the
+ <c>erlang</c> module under the names <c>binary_part/2</c> and
+ <c>binary_part/3</c>. Those BIFs are allowed in guard tests.</p>
+ </note>
+
+ <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception
+ is raised.</p>
+
+ </desc>
+ </func>
+ <func>
+ <name>part(Subject, Pos, Len) -> binary()</name>
+ <fsummary>Extracts a part of a binary</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pos = int()</v>
+ <v>Len = int()</v>
+ </type>
+ <desc>
+ <p>The same as <c>part(Subject, {Pos, Len})</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>referenced_byte_size(binary()) -> int()</name>
+ <fsummary>Determines the size of the actual binary pointed out by a sub-binary</fsummary>
+ <desc>
+
+ <p>If a binary references a larger binary (often described as
+ being a sub-binary), it can be useful to get the size of the
+ actual referenced binary. This function can be used in a program
+ to trigger the use of <c>copy/1</c>. By copying a binary, one might
+ dereference the original, possibly large, binary which a smaller
+ binary is a reference to.</p>
+
+ <p>Example:</p>
+
+ <code>
+store(Binary, GBSet) ->
+ NewBin =
+ case binary:referenced_byte_size(Binary) of
+ Large when Large > 2 * byte_size(Binary) ->
+ binary:copy(Binary);
+ _ ->
+ Binary
+ end,
+ gb_sets:insert(NewBin,GBSet).
+ </code>
+
+ <p>In this example, we chose to copy the binary content before
+ inserting it in the <c>gb_set()</c> if it references a binary more than
+ twice the size of the data we're going to keep. Of course
+ different rules for when copying will apply to different
+ programs.</p>
+
+ <p>Binary sharing will occur whenever binaries are taken apart,
+ this is the fundamental reason why binaries are fast,
+ decomposition can always be done with O(1) complexity. In rare
+ circumstances this data sharing is however undesirable, why this
+ function together with <c>copy/1</c> might be useful when optimizing
+ for memory use.</p>
+
+ <p>Example of binary sharing:</p>
+
+ <code>
+1> A = binary:copy(&lt;&lt;1&gt;&gt;,100).
+&lt;&lt;1,1,1,1,1 ...
+2> byte_size(A).
+100
+3> binary:referenced_byte_size(A)
+100
+4> &lt;&lt;_:10/binary,B:10/binary,_/binary&gt;&gt; = A.
+&lt;&lt;1,1,1,1,1 ...
+5> byte_size(B).
+10
+6> binary:referenced_byte_size(B)
+100
+ </code>
+
+ <note>
+ <p>Binary data is shared among processes. If another process
+ still references the larger binary, copying the part this
+ process uses only consumes more memory and will not free up the
+ larger binary for garbage collection. Use this kind of intrusive
+ functions with extreme care, and only if a real problem is
+ detected.</p>
+ </note>
+
+ </desc>
+ </func>
+ <func>
+ <name>replace(Subject,Pattern,Replacement) -> Result</name>
+ <fsummary>Replaces bytes in a binary according to a pattern</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Replacement = binary()</v>
+ <v>Result = binary()</v>
+ </type>
+ <desc>
+ <p>The same as <c>replace(Subject,Pattern,Replacement,[])</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>replace(Subject,Pattern,Replacement,Options) -> Result</name>
+ <fsummary>Replaces bytes in a binary according to a pattern</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Replacement = binary()</v>
+ <v>Result = binary()</v>
+ <v>Options = [ Option ]</v>
+ <v>Option = global | {scope, part()} | {insert_replaced, InsPos}</v>
+ <v>InsPos = OnePos | [ OnePos ]</v>
+ <v>OnePos = int() =&lt; byte_size(Replacement)</v>
+ </type>
+ <desc>
+
+ <p>Constructs a new binary by replacing the parts in
+ <c>Subject</c> matching <c>Pattern</c> with the content of
+ <c>Replacement</c>.</p>
+
+ <p>If the matching sub-part of <c>Subject</c> giving raise to the
+ replacement is to be inserted in the result, the option
+ <c>{insert_replaced, InsPos}</c> will insert the matching part into
+ <c>Replacement</c> at the given position (or positions) before actually
+ inserting <c>Replacement</c> into the <c>Subject</c>. Example:</p>
+
+<code>
+1> binary:replace(&lt;&lt;"abcde"&gt;&gt;,&lt;&lt;"b"&gt;&gt;,&lt;&lt;"[]"&gt;&gt;,[{insert_replaced,1}]).
+&lt;&lt;"a[b]cde"&gt;&gt;
+2> binary:replace(&lt;&lt;"abcde"&gt;&gt;,[&lt;&lt;"b"&gt;&gt;,&lt;&lt;"d"&gt;&gt;],&lt;&lt;"[]"&gt;&gt;,
+ [global,{insert_replaced,1}]).
+&lt;&lt;"a[b]c[d]e"&gt;&gt;
+3> binary:replace(&lt;&lt;"abcde"&gt;&gt;,[&lt;&lt;"b"&gt;&gt;,&lt;&lt;"d"&gt;&gt;],&lt;&lt;"[]"&gt;&gt;,
+ [global,{insert_replaced,[1,1]}]).
+&lt;&lt;"a[bb]c[dd]e"&gt;&gt;
+4> binary:replace(&lt;&lt;"abcde"&gt;&gt;,[&lt;&lt;"b"&gt;&gt;,&lt;&lt;"d"&gt;&gt;],&lt;&lt;"[-]"&gt;&gt;,
+ [global,{insert_replaced,[1,2]}]).
+&lt;&lt;"a[b-b]c[d-d]e"&gt;&gt;
+</code>
+
+ <p>If any position given in <c>InsPos</c> is greater than the size of the replacement binary, a <c>badarg</c> exception is raised.</p>
+
+ <p>The options <c>global</c> and <c>{scope, part()}</c> works as for <seealso marker="#split-3">split/3</seealso>. The return type is always a <c>binary()</c>.</p>
+
+ <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>split(Subject,Pattern) -> Parts</name>
+ <fsummary>Splits a binary according to a pattern</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Parts = [ binary() ]</v>
+ </type>
+ <desc>
+ <p>The same as <c>split(Subject, Pattern, [])</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>split(Subject,Pattern,Options) -> Parts</name>
+ <fsummary>Splits a binary according to a pattern</fsummary>
+ <type>
+ <v>Subject = binary()</v>
+ <v>Pattern = binary() | [ binary() ] | cp()</v>
+ <v>Parts = [ binary() ]</v>
+ <v>Options = [ Option ]</v>
+ <v>Option = {scope, part()} | trim | global</v>
+ </type>
+ <desc>
+
+ <p>Splits Binary into a list of binaries based on Pattern. If
+ the option global is not given, only the first occurrence of
+ Pattern in Subject will give rise to a split.</p>
+
+ <p>The parts of Pattern actually found in Subject are not included in the result.</p>
+
+ <p>Example:</p>
+
+<code>
+1> binary:split(&lt;&lt;1,255,4,0,0,0,2,3&gt;&gt;, [&lt;&lt;0,0,0&gt;&gt;,&lt;&lt;2&gt;&gt;],[]).
+[&lt;&lt;1,255,4&gt;&gt;, &lt;&lt;2,3&gt;&gt;]
+2> binary:split(&lt;&lt;0,1,0,0,4,255,255,9&gt;&gt;, [&lt;&lt;0,0&gt;&gt;, &lt;&lt;255,255&gt;&gt;],[global]).
+[&lt;&lt;0,1&gt;&gt;,&lt;&lt;4&gt;&gt;,&lt;&lt;9&gt;&gt;]
+</code>
+
+ <p>Summary of options:</p>
+ <taglist>
+
+ <tag>{scope, part()}</tag>
+
+ <item><p>Works as in <seealso marker="#match-3">match/3</seealso> and
+ <seealso marker="#matches-3">matches/3</seealso>. Note that
+ this only defines the scope of the search for matching strings,
+ it does not cut the binary before splitting. The bytes before
+ and after the scope will be kept in the result. See example
+ below.</p></item>
+
+ <tag>trim</tag>
+
+ <item><p>Removes trailing empty parts of the result (as does trim in <c>re:split/3</c>)</p></item>
+
+ <tag>global</tag>
+
+ <item><p>Repeats the split until the <c>Subject</c> is
+ exhausted. Conceptually the global option makes split work on
+ the positions returned by <seealso marker="#matches-3">matches/3</seealso>,
+ while it normally
+ works on the position returned by
+ <seealso marker="#match-3">match/3</seealso>.</p></item>
+
+ </taglist>
+
+ <p>Example of the difference between a scope and taking the
+ binary apart before splitting:</p>
+
+<code>
+1> binary:split(&lt;&lt;"banana"&gt;&gt;,[&lt;&lt;"a"&gt;&gt;],[{scope,{2,3}}]).
+[&lt;&lt;"ban"&gt;&gt;,&lt;&lt;"na"&gt;&gt;]
+2> binary:split(binary:part(&lt;&lt;"banana"&gt;&gt;,{2,3}),[&lt;&lt;"a"&gt;&gt;],[]).
+[&lt;&lt;"n"&gt;&gt;,&lt;&lt;"n"&gt;&gt;]
+</code>
+
+ <p>The return type is always a list of binaries that are all
+ referencing <c>Subject</c>. This means that the data in <c>Subject</c> is not
+ actually copied to new binaries and that <c>Subject</c> cannot be
+ garbage collected until the results of the split are no longer
+ referenced.</p>
+
+ <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p>
+
+ </desc>
+ </func>
+ </funcs>
+</erlref>
diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml
index f6ae368e92..85aae6151d 100644
--- a/lib/stdlib/doc/src/ref_man.xml
+++ b/lib/stdlib/doc/src/ref_man.xml
@@ -4,7 +4,7 @@
<application xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>1996</year><year>2009</year>
+ <year>1996</year><year>2010</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -13,12 +13,12 @@
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.
-
+
</legalnotice>
<title>STDLIB Reference Manual</title>
@@ -37,6 +37,7 @@
<xi:include href="array.xml"/>
<xi:include href="base64.xml"/>
<xi:include href="beam_lib.xml"/>
+ <xi:include href="binary.xml"/>
<xi:include href="c.xml"/>
<xi:include href="calendar.xml"/>
<xi:include href="dets.xml"/>
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index 237818c08b..600303d7e1 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -43,6 +43,7 @@ MODULES= \
array \
base64 \
beam_lib \
+ binary \
c \
calendar \
dets \
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
new file mode 100644
index 0000000000..f6489788b2
--- /dev/null
+++ b/lib/stdlib/src/binary.erl
@@ -0,0 +1,177 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(binary).
+%%
+%% The following functions implemented as BIF's
+%% binary:compile_pattern/1
+%% binary:match/{2,3}
+%% binary:matches/{2,3}
+%% binary:longest_common_prefix/1
+%% binary:longest_common_suffix/1
+%% binary:first/1
+%% binary:last/1
+%% binary:at/2
+%% binary:part/{2,3}
+%% binary:bin_to_list/{1,2,3}
+%% binary:list_to_bin/1
+%% binary:copy/{1,2}
+%% binary:referenced_byte_size/1
+%% binary:decode_unsigned/{1,2}
+%% - Not yet:
+%%
+%% Implemented in this module:
+-export([split/2,split/3,replace/3,replace/4]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% split
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+split(H,N) ->
+ split(H,N,[]).
+split(Haystack,Needles,Options) ->
+ try
+ {Part,Global,Trim} = get_opts_split(Options,{no,false,false}),
+ Moptlist = case Part of
+ no ->
+ [];
+ {A,B} ->
+ [{scope,{A,B}}]
+ end,
+ MList = if
+ Global ->
+ binary:matches(Haystack,Needles,Moptlist);
+ true ->
+ case binary:match(Haystack,Needles,Moptlist) of
+ nomatch -> [];
+ Match -> [Match]
+ end
+ end,
+ do_split(Haystack,MList,0,Trim)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_split(H,[],N,true) when N >= byte_size(H) ->
+ [];
+do_split(H,[],N,_) ->
+ [binary:part(H,{N,byte_size(H)-N})];
+do_split(H,[{A,B}|T],N,Trim) ->
+ case binary:part(H,{N,A-N}) of
+ <<>> ->
+ Rest = do_split(H,T,A+B,Trim),
+ case {Trim, Rest} of
+ {true,[]} ->
+ [];
+ _ ->
+ [<<>> | Rest]
+ end;
+ Oth ->
+ [Oth | do_split(H,T,A+B,Trim)]
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% replace
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+replace(H,N,R) ->
+ replace(H,N,R,[]).
+replace(Haystack,Needles,Replacement,Options) ->
+ try
+ true = is_binary(Replacement), % Make badarg instead of function clause
+ {Part,Global,Insert} = get_opts_replace(Options,{no,false,[]}),
+ Moptlist = case Part of
+ no ->
+ [];
+ {A,B} ->
+ [{scope,{A,B}}]
+ end,
+ MList = if
+ Global ->
+ binary:matches(Haystack,Needles,Moptlist);
+ true ->
+ case binary:match(Haystack,Needles,Moptlist) of
+ nomatch -> [];
+ Match -> [Match]
+ end
+ end,
+ ReplList = case Insert of
+ [] ->
+ Replacement;
+ Y when is_integer(Y) ->
+ splitat(Replacement,0,[Y]);
+ Li when is_list(Li) ->
+ splitat(Replacement,0,lists:sort(Li))
+ end,
+ erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0))
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+
+do_replace(H,[],_,N) ->
+ [binary:part(H,{N,byte_size(H)-N})];
+do_replace(H,[{A,B}|T],Replacement,N) ->
+ [binary:part(H,{N,A-N}),
+ if
+ is_list(Replacement) ->
+ do_insert(Replacement, binary:part(H,{A,B}));
+ true ->
+ Replacement
+ end
+ | do_replace(H,T,Replacement,A+B)].
+
+do_insert([X],_) ->
+ [X];
+do_insert([H|T],R) ->
+ [H,R|do_insert(T,R)].
+
+splitat(H,N,[]) ->
+ [binary:part(H,{N,byte_size(H)-N})];
+splitat(H,N,[I|T]) ->
+ [binary:part(H,{N,I-N})|splitat(H,I,T)].
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Simple helper functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_opts_split([],{Part,Global,Trim}) ->
+ {Part,Global,Trim};
+get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) ->
+ get_opts_split(T,{{A,B},Global,Trim});
+get_opts_split([global | T],{Part,_Global,Trim}) ->
+ get_opts_split(T,{Part,true,Trim});
+get_opts_split([trim | T],{Part,Global,_Trim}) ->
+ get_opts_split(T,{Part,Global,true});
+get_opts_split(_,_) ->
+ throw(badopt).
+
+get_opts_replace([],{Part,Global,Insert}) ->
+ {Part,Global,Insert};
+get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) ->
+ get_opts_replace(T,{{A,B},Global,Insert});
+get_opts_replace([global | T],{Part,_Global,Insert}) ->
+ get_opts_replace(T,{Part,true,Insert});
+get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) ->
+ get_opts_replace(T,{Part,Global,N});
+get_opts_replace(_,_) ->
+ throw(badopt).
+
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index 16173d8210..2471c545dd 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(erl_internal).
@@ -87,6 +87,8 @@ guard_bif(is_reference, 1) -> true;
guard_bif(is_tuple, 1) -> true;
guard_bif(is_record, 2) -> true;
guard_bif(is_record, 3) -> true;
+guard_bif(binary_part, 2) -> true;
+guard_bif(binary_part, 3) -> true;
guard_bif(Name, A) when is_atom(Name), is_integer(A) -> false.
%% Erlang type tests.
@@ -229,6 +231,8 @@ bif(apply, 2) -> true;
bif(apply, 3) -> true;
bif(atom_to_binary, 2) -> true;
bif(atom_to_list, 1) -> true;
+bif(binary_part, 2) -> true;
+bif(binary_part, 3) -> true;
bif(binary_to_atom, 2) -> true;
bif(binary_to_existing_atom, 2) -> true;
bif(binary_to_list, 1) -> true;
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 3e52c48e42..9d15f01683 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -1,20 +1,20 @@
%% This is an -*- erlang -*- file.
%%
%% %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%
%%
{application, stdlib,
@@ -23,6 +23,7 @@
{modules, [array,
base64,
beam_lib,
+ binary,
c,
calendar,
dets,
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 9beac93eb8..3bbd9ce318 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -9,6 +9,8 @@ MODULES= \
array_SUITE \
base64_SUITE \
beam_lib_SUITE \
+ binary_module_SUITE \
+ binref \
c_SUITE \
calendar_SUITE \
dets_SUITE \
diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl
new file mode 100644
index 0000000000..16ed9a2c26
--- /dev/null
+++ b/lib/stdlib/test/binary_module_SUITE.erl
@@ -0,0 +1,1323 @@
+-module(binary_module_SUITE).
+
+-export([all/1, interesting/1,random_ref_comp/1,random_ref_sr_comp/1,
+ random_ref_fla_comp/1,parts/1, bin_to_list/1, list_to_bin/1,
+ copy/1, referenced/1,guard/1,encode_decode/1,badargs/1,longest_common_trap/1]).
+
+-export([random_number/1, make_unaligned/1]).
+
+
+
+%%-define(STANDALONE,1).
+
+-ifdef(STANDALONE).
+
+-define(line,erlang:display({?MODULE,?LINE}),).
+
+-else.
+
+-include("test_server.hrl").
+-export([init_per_testcase/2, fin_per_testcase/2]).
+% Default timetrap timeout (set in init_per_testcase).
+% Some of these testcases are really heavy...
+-define(default_timeout, ?t:minutes(20)).
+
+-endif.
+
+
+
+-ifdef(STANDALONE).
+-export([run/0]).
+
+run() ->
+ [ apply(?MODULE,X,[[]]) || X <- all(suite) ].
+
+-else.
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ [{watchdog, Dog} | Config].
+
+fin_per_testcase(_Case, Config) ->
+ ?line Dog = ?config(watchdog, Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+-endif.
+
+all(suite) -> [interesting,random_ref_fla_comp,random_ref_sr_comp,
+ random_ref_comp,parts,bin_to_list, list_to_bin, copy,
+ referenced,guard,encode_decode,badargs,longest_common_trap].
+
+-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
+
+
+badargs(doc) ->
+ ["Tests various badarg exceptions in the module"];
+badargs(Config) when is_list(Config) ->
+ ?line badarg = ?MASK_ERROR(binary:compile_pattern([<<1,2,3:3>>])),
+ ?line badarg = ?MASK_ERROR(binary:compile_pattern([<<1,2,3>>|<<1,2>>])),
+ ?line badarg = ?MASK_ERROR(binary:compile_pattern(<<1,2,3:3>>)),
+ ?line badarg = ?MASK_ERROR(binary:compile_pattern(<<>>)),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3:3>>,<<1>>)),
+ ?line badarg = ?MASK_ERROR(binary:matches(<<1,2,3:3>>,<<1>>)),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{0,1},1}])),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,
+ [{scape,{0,1}}])),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{0,1,1}}])),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,0,1}])),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,[0,1]}])),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{0.1,1}}])),
+ ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{1,1.1}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{16#FF,
+ 16#FFFFFFFFFFFFFFFF}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{16#FFFFFFFFFFFFFFFF,
+ -16#7FFFFFFFFFFFFFFF-1}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:match(<<1,2,3>>,<<1>>,
+ [{scope,{16#FFFFFFFFFFFFFFFF,
+ 16#7FFFFFFFFFFFFFFF}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:part(<<1,2,3>>,{16#FF,
+ 16#FFFFFFFFFFFFFFFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ -16#7FFFFFFFFFFFFFFF-1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ 16#7FFFFFFFFFFFFFFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:part(make_unaligned(<<1,2,3>>),{1,1,1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(make_unaligned(<<1,2,3>>),{1,1,1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFF,
+ -16#7FFFFFFFFFFFFFFF-1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(make_unaligned(<<1,2,3>>),{16#FF,
+ 16#FFFFFFFFFFFFFFFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFF,
+ 16#7FFFFFFFFFFFFFFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFFFF,
+ -16#7FFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary_part(make_unaligned(<<1,2,3>>),{16#FF,
+ -16#7FFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,{16#FF,
+ 16#FFFFFFFFFFFFFFFF})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ -16#7FFFFFFFFFFFFFFF-1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
+ 16#7FFFFFFFFFFFFFFF})),
+ ?line [1,2,3] =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,[])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,{1,2,3})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,{1.0,1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3>>,{1,1.0})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3:3>>,{1,1})),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list(<<1,2,3:3>>)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:bin_to_list([1,2,3])),
+
+ ?line nomatch =
+ ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,{0,0}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:match(<<1,2,3>>,{bm,<<>>},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:match(<<1,2,3>>,[],[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:match(<<1,2,3>>,{ac,<<>>},[{scope,{0,1}}])),
+ ?line {bm,BMMagic} = binary:compile_pattern([<<1,2,3>>]),
+ ?line {ac,ACMagic} = binary:compile_pattern([<<1,2,3>>,<<4,5>>]),
+ ?line badarg =
+ ?MASK_ERROR(binary:match(<<1,2,3>>,{bm,ACMagic},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:match(<<1,2,3>>,{ac,BMMagic},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:match(<<1,2,3>>,
+ {bm,ets:match_spec_compile([{'_',[],['$_']}])},
+ [{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:match(<<1,2,3>>,
+ {ac,ets:match_spec_compile([{'_',[],['$_']}])},
+ [{scope,{0,1}}])),
+ ?line nomatch =
+ ?MASK_ERROR(binary:matches(<<1,2,3>>,<<1>>,[{scope,{0,0}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:matches(<<1,2,3>>,{bm,<<>>},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:matches(<<1,2,3>>,[],[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:matches(<<1,2,3>>,{ac,<<>>},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:matches(<<1,2,3>>,{bm,ACMagic},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:matches(<<1,2,3>>,{ac,BMMagic},[{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:matches(<<1,2,3>>,
+ {bm,ets:match_spec_compile([{'_',[],['$_']}])},
+ [{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:matches(<<1,2,3>>,
+ {ac,ets:match_spec_compile([{'_',[],['$_']}])},
+ [{scope,{0,1}}])),
+ ?line badarg =
+ ?MASK_ERROR(binary:longest_common_prefix(
+ [<<0:10000,1,2,4,1:3>>,
+ <<0:10000,1,2,3>>])),
+ ?line badarg =
+ ?MASK_ERROR(binary:longest_common_suffix(
+ [<<0:10000,1,2,4,1:3>>,
+ <<0:10000,1,2,3>>])),
+ ?line badarg =
+ ?MASK_ERROR(binary:encode_unsigned(-1)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:encode_unsigned(-16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:first(<<1,2,4,1:3>>)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:first([1,2,4])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:last(<<1,2,4,1:3>>)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:last([1,2,4])),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:at(<<1,2,4,1:3>>,2)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:at(<<>>,2)),
+ ?line badarg =
+ ?MASK_ERROR(
+ binary:at([1,2,4],2)),
+ ok.
+
+longest_common_trap(doc) ->
+ ["Whitebox test to force special trap conditions in longest_common_{prefix,suffix}"];
+longest_common_trap(Config) when is_list(Config) ->
+ ?line erts_debug:set_internal_state(available_internal_state,true),
+ ?line io:format("oldlimit: ~p~n",
+ [erts_debug:set_internal_state(binary_loop_limit,10)]),
+ erlang:bump_reductions(10000000),
+ ?line _ = binary:longest_common_prefix(
+ [<<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0:10000,1,3,3>>,
+ <<0:10000,1,2,4>>]),
+ ?line _ = binary:longest_common_prefix(
+ [<<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0,0,0,0,0,0,0,0,0,0,0,0,0,0>>,
+ <<0:10000,1,2,4>>]),
+ erlang:bump_reductions(10000000),
+ ?line _ = binary:longest_common_suffix(
+ [<<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,3,3,0:10000,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>,
+ <<1,2,4,0:10000>>]),
+ ?line _ = binary:longest_common_suffix(
+ [<<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<1,2,4,0:10000>>,
+ <<0,0,0,0,0,0,0,0,0,0,0,0,0,0>>,
+ <<1,2,4,0:10000>>]),
+ Subj = subj(),
+ Len = byte_size(Subj),
+ ?line Len = binary:longest_common_suffix(
+ [Subj,Subj,Subj]),
+ ?line io:format("limit was: ~p~n",
+ [erts_debug:set_internal_state(binary_loop_limit,
+ default)]),
+ ?line erts_debug:set_internal_state(available_internal_state,false),
+ ok.
+
+subj() ->
+ Me = self(),
+ spawn(fun() ->
+ X0 = iolist_to_binary([
+ "1234567890",
+ %lists:seq(16#21, 16#7e),
+ lists:duplicate(100, $x)
+ ]),
+ Me ! X0,
+ receive X -> X end
+ end),
+ X0 = receive A -> A end,
+ <<X1:32/binary,_/binary>> = X0,
+ Subject= <<X1/binary>>,
+ Subject.
+
+
+interesting(doc) ->
+ ["Try some interesting patterns"];
+interesting(Config) when is_list(Config) ->
+ X = do_interesting(binary),
+ X = do_interesting(binref).
+
+do_interesting(Module) ->
+ ?line {0,4} = Module:match(<<"123456">>,
+ Module:compile_pattern([<<"12">>,<<"1234">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>,<<"6">>])),
+ ?line [{0,4},{5,1}] = Module:matches(<<"123456">>,
+ Module:compile_pattern([<<"12">>,<<"1234">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>,<<"6">>])),
+ ?line [{0,4}] = Module:matches(<<"123456">>,
+ Module:compile_pattern([<<"12">>,<<"1234">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>])),
+ ?line [{0,2},{2,2}] = Module:matches(<<"123456">>,
+ Module:compile_pattern([<<"12">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>])),
+ ?line {1,4} = Module:match(<<"123456">>,
+ Module:compile_pattern([<<"34">>,<<"34">>,
+ <<"12347">>,<<"2345">>])),
+ ?line [{1,4}] = Module:matches(<<"123456">>,
+ Module:compile_pattern([<<"34">>,<<"34">>,
+ <<"12347">>,<<"2345">>])),
+ ?line [{2,2}] = Module:matches(<<"123456">>,
+ Module:compile_pattern([<<"34">>,<<"34">>,
+ <<"12347">>,<<"2346">>])),
+
+ ?line {0,4} = Module:match(<<"123456">>,
+ [<<"12">>,<<"1234">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>,<<"6">>]),
+ ?line [{0,4},{5,1}] = Module:matches(<<"123456">>,
+ [<<"12">>,<<"1234">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>,<<"6">>]),
+ ?line [{0,4}] = Module:matches(<<"123456">>,
+ [<<"12">>,<<"1234">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>]),
+ ?line [{0,2},{2,2}] = Module:matches(<<"123456">>,
+ [<<"12">>,
+ <<"23">>,<<"3">>,
+ <<"34">>,<<"456">>,
+ <<"45">>]),
+ ?line {1,4} = Module:match(<<"123456">>,
+ [<<"34">>,<<"34">>,
+ <<"12347">>,<<"2345">>]),
+ ?line [{1,4}] = Module:matches(<<"123456">>,
+ [<<"34">>,<<"34">>,
+ <<"12347">>,<<"2345">>]),
+ ?line [{2,2}] = Module:matches(<<"123456">>,
+ [<<"34">>,<<"34">>,
+ <<"12347">>,<<"2346">>]),
+ ?line nomatch = Module:match(<<1,2,3,4>>,<<2>>,[{scope,{0,1}}]),
+ ?line {1,1} = Module:match(<<1,2,3,4>>,<<2>>,[{scope,{0,2}}]),
+ ?line nomatch = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,2}}]),
+ ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,3}}]),
+ ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,4}}]),
+ ?line badarg = ?MASK_ERROR(Module:match(<<1,2,3,4>>,<<2,3>>,
+ [{scope,{0,5}}])),
+ ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{4,-4}}]),
+ ?line {0,3} = Module:match(<<1,2,3,4>>,<<1,2,3>>,[{scope,{4,-4}}]),
+ ?line {0,4} = Module:match(<<1,2,3,4>>,<<1,2,3,4>>,[{scope,{4,-4}}]),
+ ?line badarg = ?MASK_ERROR(Module:match(<<1,2,3,4>>,<<1,2,3,4>>,
+ [{scope,{3,-4}}])),
+ ?line [] = Module:matches(<<1,2,3,4>>,<<2>>,[{scope,{0,1}}]),
+ ?line [{1,1}] = Module:matches(<<1,2,3,4>>,[<<2>>,<<3>>],[{scope,{0,2}}]),
+ ?line [] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,2}}]),
+ ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,3}}]),
+ ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,4}}]),
+ ?line [{1,2}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>],
+ [{scope,{0,3}}]),
+ ?line [{1,2},{3,1}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>],
+ [{scope,{0,4}}]),
+ ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,<<2,3>>,
+ [{scope,{0,5}}])),
+ ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{4,-4}}]),
+ ?line [{1,2},{3,1}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>],
+ [{scope,{4,-4}}]),
+ ?line [{0,3}] = Module:matches(<<1,2,3,4>>,<<1,2,3>>,[{scope,{4,-4}}]),
+ ?line [{0,4}] = Module:matches(<<1,2,3,4>>,<<1,2,3,4>>,[{scope,{4,-4}}]),
+ ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,<<1,2,3,4>>,
+ [{scope,{3,-4}}])),
+ ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,[<<1,2,3,4>>],
+ [{scope,{3,-4}}])),
+ ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,<<4,5>>),
+ ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>]),
+ ?line [<<1,2,3>>,<<6>>,<<8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>],[global]),
+ ?line [<<1,2,3>>,<<6>>,<<>>,<<>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],
+ [global]),
+ ?line [<<1,2,3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],
+ [global,trim]),
+ ?line [<<1,2,3,4,5,6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],
+ [global,trim,{scope,{0,4}}]),
+ ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],
+ [global,trim,{scope,{0,5}}]),
+ ?line badarg = ?MASK_ERROR(
+ Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global,trim,{scope,{0,5}}])),
+ ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,[]),
+ ?line <<1,2,3,99,6,99,99>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global]),
+ ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global,{scope,{0,5}}]),
+ ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global,{scope,{0,5}}]),
+ ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global,{scope,{0,5}}]),
+ ?line badarg = ?MASK_ERROR(Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global,{scope,{0,5}},
+ {insert,1}])),
+ ?line <<1,2,3,99,4,5,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<99>>,
+ [global,{scope,{0,5}},
+ {insert_replaced,1}]),
+ ?line <<1,2,3,9,4,5,9,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],
+ <<9,9>>,
+ [global,{scope,{0,5}},
+ {insert_replaced,1}]),
+ ?line badarg = ?MASK_ERROR(Module:replace(<<1,2,3,4,5,6,7,8>>,
+ [<<4,5>>,<<7>>,<<8>>],<<>>,
+ [global,{scope,{0,5}},
+ {insert_replaced,1}])),
+ ?line 2 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>]),
+ ?line 2 = Module:longest_common_prefix([<<1,2,4>>,<<1,2>>]),
+ ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1>>]),
+ ?line 0 = Module:longest_common_prefix([<<1,2,4>>,<<>>]),
+ ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>,<<1,3,3>>]),
+ ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>,<<1,3,3>>,<<1,2,4>>]),
+ ?line 1251 = Module:longest_common_prefix([<<0:10000,1,2,4>>,
+ <<0:10000,1,2,3>>,
+ <<0:10000,1,3,3>>,
+ <<0:10000,1,2,4>>]),
+ ?line 12501 = Module:longest_common_prefix([<<0:100000,1,2,4>>,
+ <<0:100000,1,2,3>>,
+ <<0:100000,1,3,3>>,
+ <<0:100000,1,2,4>>]),
+ ?line 1251 = Module:longest_common_prefix(
+ [make_unaligned(<<0:10000,1,2,4>>),
+ <<0:10000,1,2,3>>,
+ make_unaligned(<<0:10000,1,3,3>>),
+ <<0:10000,1,2,4>>]),
+ ?line 12501 = Module:longest_common_prefix(
+ [<<0:100000,1,2,4>>,
+ make_unaligned(<<0:100000,1,2,3>>),
+ <<0:100000,1,3,3>>,
+ make_unaligned(<<0:100000,1,2,4>>)]),
+ ?line 1250001 = Module:longest_common_prefix([<<0:10000000,1,2,4>>,
+ <<0:10000000,1,2,3>>,
+ <<0:10000000,1,3,3>>,
+ <<0:10000000,1,2,4>>]),
+ if % Too cruel for the reference implementation
+ Module =:= binary ->
+ ?line erts_debug:set_internal_state(available_internal_state,true),
+ ?line io:format("oldlimit: ~p~n",
+ [erts_debug:set_internal_state(
+ binary_loop_limit,100)]),
+ ?line 1250001 = Module:longest_common_prefix(
+ [<<0:10000000,1,2,4>>,
+ <<0:10000000,1,2,3>>,
+ <<0:10000000,1,3,3>>,
+ <<0:10000000,1,2,4>>]),
+ ?line io:format("limit was: ~p~n",
+ [erts_debug:set_internal_state(binary_loop_limit,
+ default)]),
+ ?line erts_debug:set_internal_state(available_internal_state,
+ false);
+ true ->
+ ok
+ end,
+ ?line 1 = Module:longest_common_suffix([<<0:100000000,1,2,4,5>>,
+ <<0:100000000,1,2,3,5>>,
+ <<0:100000000,1,3,3,5>>,
+ <<0:100000000,1,2,4,5>>]),
+ ?line 1 = Module:longest_common_suffix([<<1,2,4,5>>,
+ <<0:100000000,1,2,3,5>>,
+ <<0:100000000,1,3,3,5>>,
+ <<0:100000000,1,2,4,5>>]),
+ ?line 1 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>,
+ <<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5>>]),
+ ?line 0 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>,
+ <<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4>>]),
+ ?line 2 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>,
+ <<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5,5>>]),
+ ?line 1 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5>>,
+ <<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5,5>>]),
+ ?line 0 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<>>,
+ <<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5,5>>]),
+ ?line 0 = Module:longest_common_suffix([<<>>,<<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5,5>>]),
+ ?line 0 = Module:longest_common_suffix([<<>>,<<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5,5>>]),
+ ?line 2 = Module:longest_common_suffix([<<5,5>>,<<0:100000000,1,3,3,5,5>>,
+ <<0:100000000,1,2,4,5,5>>]),
+ ?line 2 = Module:longest_common_suffix([<<5,5>>,<<5,5>>,<<4,5,5>>]),
+ ?line 2 = Module:longest_common_suffix([<<5,5>>,<<5,5>>,<<5,5>>]),
+ ?line 3 = Module:longest_common_suffix([<<4,5,5>>,<<4,5,5>>,<<4,5,5>>]),
+ ?line 0 = Module:longest_common_suffix([<<>>]),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([])),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([apa])),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([[<<>>]])),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([[<<0>>,
+ <<1:9>>]])),
+ ?line 0 = Module:longest_common_prefix([<<>>]),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([])),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([apa])),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([[<<>>]])),
+ ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([[<<0>>,
+ <<1:9>>]])),
+
+ ?line <<1:6,Bin:3/binary,_:2>> = <<1:6,1,2,3,1:2>>,
+ ?line <<1,2,3>> = Bin,
+ ?line 1 = Module:first(Bin),
+ ?line 1 = Module:first(<<1>>),
+ ?line 1 = Module:first(<<1,2,3>>),
+ ?line badarg = ?MASK_ERROR(Module:first(<<>>)),
+ ?line badarg = ?MASK_ERROR(Module:first(apa)),
+ ?line 3 = Module:last(Bin),
+ ?line 1 = Module:last(<<1>>),
+ ?line 3 = Module:last(<<1,2,3>>),
+ ?line badarg = ?MASK_ERROR(Module:last(<<>>)),
+ ?line badarg = ?MASK_ERROR(Module:last(apa)),
+ ?line 1 = Module:at(Bin,0),
+ ?line 1 = Module:at(<<1>>,0),
+ ?line 1 = Module:at(<<1,2,3>>,0),
+ ?line 2 = Module:at(<<1,2,3>>,1),
+ ?line 3 = Module:at(<<1,2,3>>,2),
+ ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,3)),
+ ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,-1)),
+ ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,apa)),
+ ?line "hejsan" = [ Module:at(<<"hejsan">>,I) || I <- lists:seq(0,5) ],
+
+ ?line badarg = ?MASK_ERROR(Module:bin_to_list(<<1,2,3>>,3,-4)),
+ ?line [1,2,3] = ?MASK_ERROR(Module:bin_to_list(<<1,2,3>>,3,-3)),
+
+ ?line badarg = ?MASK_ERROR(Module:decode_unsigned(<<1,2,1:2>>,big)),
+ ?line badarg = ?MASK_ERROR(Module:decode_unsigned(<<1,2,1:2>>,little)),
+ ?line badarg = ?MASK_ERROR(Module:decode_unsigned(apa)),
+ ?line badarg = ?MASK_ERROR(Module:decode_unsigned(125,little)),
+ ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<>>,little)),
+ ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<>>,big)),
+ ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<0>>,little)),
+ ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<0>>,big)),
+ ?line 0 = ?MASK_ERROR(Module:decode_unsigned(make_unaligned(<<0>>),
+ little)),
+ ?line 0 = ?MASK_ERROR(Module:decode_unsigned(make_unaligned(<<0>>),big)),
+ ?line badarg = ?MASK_ERROR(Module:encode_unsigned(apa)),
+ ?line badarg = ?MASK_ERROR(Module:encode_unsigned(125.3,little)),
+ ?line badarg = ?MASK_ERROR(Module:encode_unsigned({1},little)),
+ ?line badarg = ?MASK_ERROR(Module:encode_unsigned([1],little)),
+ ?line <<0>> = ?MASK_ERROR(Module:encode_unsigned(0,little)),
+ ?line <<0>> = ?MASK_ERROR(Module:encode_unsigned(0,big)),
+ ok.
+
+encode_decode(doc) ->
+ ["test binary:encode_unsigned/1,2 and binary:decode_unsigned/1,2"];
+encode_decode(Config) when is_list(Config) ->
+ ?line random:seed({1271,769940,559934}),
+ ?line ok = encode_decode_loop({1,200},1000), % Need to be long enough
+ % to create offheap binaries
+ ok.
+
+encode_decode_loop(_Range,0) ->
+ ok;
+encode_decode_loop(Range, X) ->
+ ?line N = random_number(Range),
+ ?line A = binary:encode_unsigned(N),
+ ?line B = binary:encode_unsigned(N,big),
+ ?line C = binref:encode_unsigned(N),
+ ?line D = binref:encode_unsigned(N,big),
+ ?line E = binary:encode_unsigned(N,little),
+ ?line F = binref:encode_unsigned(N,little),
+ ?line G = binary:decode_unsigned(A),
+ ?line H = binary:decode_unsigned(A,big),
+ ?line I = binref:decode_unsigned(A),
+ ?line J = binary:decode_unsigned(E,little),
+ ?line K = binref:decode_unsigned(E,little),
+ ?line L = binary:decode_unsigned(make_unaligned(A)),
+ ?line M = binary:decode_unsigned(make_unaligned(E),little),
+ ?line PaddedBig = <<0:48,A/binary>>,
+ ?line PaddedLittle = <<E/binary,0:48>>,
+ ?line O = binary:decode_unsigned(PaddedBig),
+ ?line P = binary:decode_unsigned(make_unaligned(PaddedBig)),
+ ?line Q = binary:decode_unsigned(PaddedLittle,little),
+ ?line R = binary:decode_unsigned(make_unaligned(PaddedLittle),little),
+ ?line S = binref:decode_unsigned(PaddedLittle,little),
+ ?line T = binref:decode_unsigned(PaddedBig),
+ case (((A =:= B) and (B =:= C) and (C =:= D)) and
+ ((E =:= F)) and
+ ((N =:= G) and (G =:= H) and (H =:= I) and
+ (I =:= J) and (J =:= K) and (K =:= L) and (L =:= M)) and
+ ((M =:= O) and (O =:= P) and (P =:= Q) and (Q =:= R) and
+ (R =:= S) and (S =:= T)))of
+ true ->
+ encode_decode_loop(Range,X-1);
+ _ ->
+ io:format("Failed to encode/decode ~w~n(Results ~p)~n",
+ [N,[A,B,C,D,E,F,G,H,I,J,K,L,M,x,O,P,Q,R,S,T]]),
+ exit(mismatch)
+ end.
+
+guard(doc) ->
+ ["Smoke test of the guard BIFs binary_part/2,3"];
+guard(Config) when is_list(Config) ->
+ {comment, "Guard tests are run in emulator test suite"}.
+
+referenced(doc) ->
+ ["Test refernced_byte_size/1 bif."];
+referenced(Config) when is_list(Config) ->
+ ?line badarg = ?MASK_ERROR(binary:referenced_byte_size([])),
+ ?line badarg = ?MASK_ERROR(binary:referenced_byte_size(apa)),
+ ?line badarg = ?MASK_ERROR(binary:referenced_byte_size({})),
+ ?line badarg = ?MASK_ERROR(binary:referenced_byte_size(1)),
+ ?line A = <<1,2,3>>,
+ ?line B = binary:copy(A,1000),
+ ?line 3 = binary:referenced_byte_size(A),
+ ?line 3000 = binary:referenced_byte_size(B),
+ ?line <<_:8,C:2/binary>> = A,
+ ?line 3 = binary:referenced_byte_size(C),
+ ?line 2 = binary:referenced_byte_size(binary:copy(C)),
+ ?line <<_:7,D:2/binary,_:1>> = A,
+ ?line 2 = binary:referenced_byte_size(binary:copy(D)),
+ ?line 3 = binary:referenced_byte_size(D),
+ ?line <<_:8,E:2/binary,_/binary>> = B,
+ ?line 3000 = binary:referenced_byte_size(E),
+ ?line 2 = binary:referenced_byte_size(binary:copy(E)),
+ ?line <<_:7,F:2/binary,_:1,_/binary>> = B,
+ ?line 2 = binary:referenced_byte_size(binary:copy(F)),
+ ?line 3000 = binary:referenced_byte_size(F),
+ ok.
+
+
+
+list_to_bin(doc) ->
+ ["Test list_to_bin/1 bif"];
+list_to_bin(Config) when is_list(Config) ->
+ %% Just some smoke_tests first, then go nuts with random cases
+ ?line badarg = ?MASK_ERROR(binary:list_to_bin({})),
+ ?line badarg = ?MASK_ERROR(binary:list_to_bin(apa)),
+ ?line badarg = ?MASK_ERROR(binary:list_to_bin(<<"apa">>)),
+ F1 = fun(L) ->
+ ?MASK_ERROR(binref:list_to_bin(L))
+ end,
+ F2 = fun(L) ->
+ ?MASK_ERROR(binary:list_to_bin(L))
+ end,
+ ?line random_iolist:run(1000,F1,F2),
+ ok.
+
+copy(doc) ->
+ ["Test copy/1,2 bif's"];
+copy(Config) when is_list(Config) ->
+ ?line <<1,2,3>> = binary:copy(<<1,2,3>>),
+ ?line RS = random_string({1,10000}),
+ ?line RS = RS2 = binary:copy(RS),
+ ?line false = erts_debug:same(RS,RS2),
+ ?line <<>> = ?MASK_ERROR(binary:copy(<<1,2,3>>,0)),
+ ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3:3>>,2)),
+ ?line badarg = ?MASK_ERROR(binary:copy([],0)),
+ ?line <<>> = ?MASK_ERROR(binary:copy(<<>>,0)),
+ ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>,1.0)),
+ ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>,
+ 16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)),
+ ?line <<>> = binary:copy(<<>>,10000),
+ ?line random:seed({1271,769940,559934}),
+ ?line ok = random_copy(3000),
+ ?line erts_debug:set_internal_state(available_internal_state,true),
+ ?line io:format("oldlimit: ~p~n",
+ [erts_debug:set_internal_state(binary_loop_limit,10)]),
+ ?line Subj = subj(),
+ ?line XX = binary:copy(Subj,1000),
+ ?line XX = binref:copy(Subj,1000),
+ ?line ok = random_copy(1000),
+ ?line kill_copy_loop(1000),
+ ?line io:format("limit was: ~p~n",
+ [erts_debug:set_internal_state(binary_loop_limit,
+ default)]),
+ ?line erts_debug:set_internal_state(available_internal_state,false),
+ ok.
+
+kill_copy_loop(0) ->
+ ok;
+kill_copy_loop(N) ->
+ {Pid,Ref} = spawn_monitor(fun() ->
+ ok = random_copy(1000)
+ end),
+ receive
+ after 10 ->
+ ok
+ end,
+ exit(Pid,kill),
+ receive
+ {'DOWN',Ref,process,Pid,_} ->
+ kill_copy_loop(N-1)
+ after 1000 ->
+ exit(did_not_die)
+ end.
+
+random_copy(0) ->
+ ok;
+random_copy(N) ->
+ Str = random_string({0,N}),
+ Num = random:uniform(N div 10+1),
+ A = ?MASK_ERROR(binary:copy(Str,Num)),
+ B = ?MASK_ERROR(binref:copy(Str,Num)),
+ C = ?MASK_ERROR(binary:copy(make_unaligned(Str),Num)),
+ case {(A =:= B), (B =:= C)} of
+ {true,true} ->
+ random_copy(N-1);
+ _ ->
+ io:format("Failed to pick copy ~s ~p times~n",
+ [Str,Num]),
+ io:format("A:~p,~nB:~p,~n,C:~p.~n",
+ [A,B,C]),
+ exit(mismatch)
+ end.
+
+bin_to_list(doc) ->
+ ["Test bin_to_list/1,2,3 bif's"];
+bin_to_list(Config) when is_list(Config) ->
+ %% Just some smoke_tests first, then go nuts with random cases
+ ?line X = <<1,2,3,4,0:1000000,5>>,
+ ?line Y = make_unaligned(X),
+ ?line LX = binary:bin_to_list(X),
+ ?line LX = binary:bin_to_list(X,0,byte_size(X)),
+ ?line LX = binary:bin_to_list(X,byte_size(X),-byte_size(X)),
+ ?line LX = binary:bin_to_list(X,{0,byte_size(X)}),
+ ?line LX = binary:bin_to_list(X,{byte_size(X),-byte_size(X)}),
+ ?line LY = binary:bin_to_list(Y),
+ ?line LY = binary:bin_to_list(Y,0,byte_size(Y)),
+ ?line LY = binary:bin_to_list(Y,byte_size(Y),-byte_size(Y)),
+ ?line LY = binary:bin_to_list(Y,{0,byte_size(Y)}),
+ ?line LY = binary:bin_to_list(Y,{byte_size(Y),-byte_size(Y)}),
+ ?line 1 = hd(LX),
+ ?line 5 = lists:last(LX),
+ ?line 1 = hd(LY),
+ ?line 5 = lists:last(LY),
+ ?line X = list_to_binary(LY),
+ ?line Y = list_to_binary(LY),
+ ?line X = list_to_binary(LY),
+ ?line [5] = lists:nthtail(byte_size(X)-1,LX),
+ ?line [0,5] = lists:nthtail(byte_size(X)-2,LX),
+ ?line [0,5] = lists:nthtail(byte_size(Y)-2,LY),
+ ?line random:seed({1271,769940,559934}),
+ ?line ok = random_bin_to_list(5000),
+ ok.
+
+random_bin_to_list(0) ->
+ ok;
+random_bin_to_list(N) ->
+ Str = random_string({1,N}),
+ Parts0 = random_parts(10,N),
+ Parts1 = Parts0 ++ [ {X+Y,-Y} || {X,Y} <- Parts0 ],
+ [ begin
+ try
+ true = ?MASK_ERROR(binary:bin_to_list(Str,Z)) =:=
+ ?MASK_ERROR(binref:bin_to_list(Str,Z)),
+ true = ?MASK_ERROR(binary:bin_to_list(Str,Z)) =:=
+ ?MASK_ERROR(binary:bin_to_list(make_unaligned(Str),Z))
+ catch
+ _:_ ->
+ io:format("Error, Str = <<\"~s\">>.~nZ = ~p.~n",
+ [Str,Z]),
+ exit(badresult)
+ end
+ end || Z <- Parts1 ],
+ [ begin
+ try
+ true = ?MASK_ERROR(binary:bin_to_list(Str,A,B)) =:=
+ ?MASK_ERROR(binref:bin_to_list(Str,A,B)),
+ true = ?MASK_ERROR(binary:bin_to_list(Str,A,B)) =:=
+ ?MASK_ERROR(binary:bin_to_list(make_unaligned(Str),A,B))
+ catch
+ _:_ ->
+ io:format("Error, Str = <<\"~s\">>.~nA = ~p.~nB = ~p.~n",
+ [Str,A,B]),
+ exit(badresult)
+ end
+ end || {A,B} <- Parts1 ],
+ random_bin_to_list(N-1).
+
+parts(doc) ->
+ ["Test the part/2,3 bif's"];
+parts(Config) when is_list(Config) ->
+ %% Some simple smoke tests to begin with
+ ?line Simple = <<1,2,3,4,5,6,7,8>>,
+ ?line <<1,2>> = binary:part(Simple,0,2),
+ ?line <<1,2>> = binary:part(Simple,{0,2}),
+ ?line Simple = binary:part(Simple,0,8),
+ ?line Simple = binary:part(Simple,{0,8}),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,0,9)),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{0,9})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,1,8)),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{1,8})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{3,-4})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{3.0,1})),
+ ?line badarg = ?MASK_ERROR(
+ binary:part(Simple,{16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ ,1})),
+ ?line <<2,3,4,5,6,7,8>> = binary:part(Simple,{1,7}),
+ ?line <<2,3,4,5,6,7,8>> = binary:part(Simple,{8,-7}),
+ ?line Simple = binary:part(Simple,{8,-8}),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{1,-8})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{8,-9})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{0,-1})),
+ ?line <<>> = binary:part(Simple,{8,0}),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{9,0})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{-1,0})),
+ ?line badarg = ?MASK_ERROR(binary:part(Simple,{7,2})),
+ ?line <<8>> = binary:part(Simple,{7,1}),
+ ?line random:seed({1271,769940,559934}),
+ ?line random_parts(5000),
+ ok.
+
+
+random_parts(0) ->
+ ok;
+random_parts(N) ->
+ Str = random_string({1,N}),
+ Parts0 = random_parts(10,N),
+ Parts1 = Parts0 ++ [ {X+Y,-Y} || {X,Y} <- Parts0 ],
+ [ begin
+ true = ?MASK_ERROR(binary:part(Str,Z)) =:=
+ ?MASK_ERROR(binref:part(Str,Z)),
+ true = ?MASK_ERROR(binary:part(Str,Z)) =:=
+ ?MASK_ERROR(erlang:binary_part(Str,Z)),
+ true = ?MASK_ERROR(binary:part(Str,Z)) =:=
+ ?MASK_ERROR(binary:part(make_unaligned(Str),Z))
+ end || Z <- Parts1 ],
+ random_parts(N-1).
+
+random_parts(0,_) ->
+ [];
+random_parts(X,N) ->
+ Pos = random:uniform(N),
+ Len = random:uniform((Pos * 12) div 10),
+ [{Pos,Len} | random_parts(X-1,N)].
+
+random_ref_comp(doc) ->
+ ["Test pseudorandomly generated cases against reference imlementation"];
+random_ref_comp(Config) when is_list(Config) ->
+ ?line put(success_counter,0),
+ ?line random:seed({1271,769940,559934}),
+ ?line do_random_match_comp(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_match_comp2(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_match_comp3(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_match_comp4(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_matches_comp(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_matches_comp2(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_matches_comp3(5,{1,40},{30,1000}),
+ ?line erts_debug:set_internal_state(available_internal_state,true),
+ ?line io:format("oldlimit: ~p~n",[ erts_debug:set_internal_state(binary_loop_limit,100)]),
+ ?line do_random_match_comp(5000,{1,40},{30,1000}),
+ ?line do_random_matches_comp3(5,{1,40},{30,1000}),
+ ?line io:format("limit was: ~p~n",[ erts_debug:set_internal_state(binary_loop_limit,default)]),
+ ?line erts_debug:set_internal_state(available_internal_state,false),
+ ok.
+
+random_ref_sr_comp(doc) ->
+ ["Test pseudorandomly generated cases against reference imlementation of split and replace"];
+random_ref_sr_comp(Config) when is_list(Config) ->
+ ?line put(success_counter,0),
+ ?line random:seed({1271,769940,559934}),
+ ?line do_random_split_comp(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_replace_comp(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_split_comp2(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ?line do_random_replace_comp2(5000,{1,40},{30,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ok.
+random_ref_fla_comp(doc) ->
+ ["Test pseudorandomly generated cases against reference imlementation of split and replace"];
+random_ref_fla_comp(Config) when is_list(Config) ->
+ ?line put(success_counter,0),
+ ?line random:seed({1271,769940,559934}),
+ ?line do_random_first_comp(5000,{1,1000}),
+ ?line do_random_last_comp(5000,{1,1000}),
+ ?line do_random_at_comp(5000,{1,1000}),
+ io:format("Number of successes: ~p~n",[get(success_counter)]),
+ ok.
+
+do_random_first_comp(0,_) ->
+ ok;
+do_random_first_comp(N,Range) ->
+ S = random_string(Range),
+ A = ?MASK_ERROR(binref:first(S)),
+ B = ?MASK_ERROR(binary:first(S)),
+ C = ?MASK_ERROR(binary:first(make_unaligned(S))),
+ case {(A =:= B), (B =:= C)} of
+ {true,true} ->
+ do_random_first_comp(N-1,Range);
+ _ ->
+ io:format("Failed to pick first of ~s~n",
+ [S]),
+ io:format("A:~p,~nB:~p,~n,C:~p.~n",
+ [A,B,C]),
+ exit(mismatch)
+ end.
+
+do_random_last_comp(0,_) ->
+ ok;
+do_random_last_comp(N,Range) ->
+ S = random_string(Range),
+ A = ?MASK_ERROR(binref:last(S)),
+ B = ?MASK_ERROR(binary:last(S)),
+ C = ?MASK_ERROR(binary:last(make_unaligned(S))),
+ case {(A =:= B), (B =:= C)} of
+ {true,true} ->
+ do_random_last_comp(N-1,Range);
+ _ ->
+ io:format("Failed to pick last of ~s~n",
+ [S]),
+ io:format("A:~p,~nB:~p,~n,C:~p.~n",
+ [A,B,C]),
+ exit(mismatch)
+ end.
+do_random_at_comp(0,_) ->
+ ok;
+do_random_at_comp(N,{Min,Max}=Range) ->
+ S = random_string(Range),
+ XMax = Min + ((Max - Min) * 3) div 4,
+ Pos = random_length({Min,XMax}), %% some out of range
+ A = ?MASK_ERROR(binref:at(S,Pos)),
+ B = ?MASK_ERROR(binary:at(S,Pos)),
+ C = ?MASK_ERROR(binary:at(make_unaligned(S),Pos)),
+ if
+ A =/= badarg ->
+ put(success_counter,get(success_counter)+1);
+ true ->
+ ok
+ end,
+ case {(A =:= B), (B =:= C)} of
+ {true,true} ->
+ do_random_at_comp(N-1,Range);
+ _ ->
+ io:format("Failed to pick last of ~s~n",
+ [S]),
+ io:format("A:~p,~nB:~p,~n,C:~p.~n",
+ [A,B,C]),
+ exit(mismatch)
+ end.
+
+do_random_matches_comp(0,_,_) ->
+ ok;
+do_random_matches_comp(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Needles = [random_string(NeedleRange) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ Haystack = random_string(HaystackRange),
+ true = do_matches_comp(Needles,Haystack),
+ do_random_matches_comp(N-1,NeedleRange,HaystackRange).
+
+do_random_matches_comp2(0,_,_) ->
+ ok;
+do_random_matches_comp2(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Haystack = random_string(HaystackRange),
+ Needles = [random_substring(NeedleRange,Haystack) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ true = do_matches_comp(Needles,Haystack),
+ do_random_matches_comp2(N-1,NeedleRange,HaystackRange).
+
+do_random_matches_comp3(0,_,_) ->
+ ok;
+do_random_matches_comp3(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Haystack = random_string(HaystackRange),
+ Needles = [random_substring(NeedleRange,Haystack) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ RefRes = binref:matches(Haystack,Needles),
+ true = do_matches_comp_loop(10000,Needles,Haystack, RefRes),
+ do_random_matches_comp3(N-1,NeedleRange,HaystackRange).
+
+do_matches_comp_loop(0,_,_,_) ->
+ true;
+do_matches_comp_loop(N, Needles, Haystack0,RR) ->
+ DummySize=N*8,
+ Haystack1 = <<0:DummySize,Haystack0/binary>>,
+ RR1=[{X+N,Y} || {X,Y} <- RR],
+ true = do_matches_comp2(Needles,Haystack1,RR1),
+ Haystack2 = <<Haystack0/binary,Haystack1/binary>>,
+ RR2 = RR ++ [{X2+N+byte_size(Haystack0),Y2} || {X2,Y2} <- RR],
+ true = do_matches_comp2(Needles,Haystack2,RR2),
+ do_matches_comp_loop(N-1, Needles, Haystack0,RR).
+
+
+do_matches_comp2(N,H,A) ->
+ C = ?MASK_ERROR(binary:matches(H,N)),
+ case (A =:= C) of
+ true ->
+ true;
+ _ ->
+ io:format("Failed to match ~p (needle) against ~s (haystack)~n",
+ [N,H]),
+ io:format("A:~p,~n,C:~p.~n",
+ [A,C]),
+ exit(mismatch)
+ end.
+do_matches_comp(N,H) ->
+ A = ?MASK_ERROR(binref:matches(H,N)),
+ B = ?MASK_ERROR(binref:matches(H,binref:compile_pattern(N))),
+ C = ?MASK_ERROR(binary:matches(H,N)),
+ D = ?MASK_ERROR(binary:matches(make_unaligned(H),
+ binary:compile_pattern([make_unaligned2(X) || X <- N]))),
+ if
+ A =/= nomatch ->
+ put(success_counter,get(success_counter)+1);
+ true ->
+ ok
+ end,
+ case {(A =:= B), (B =:= C),(C =:= D)} of
+ {true,true,true} ->
+ true;
+ _ ->
+ io:format("Failed to match ~p (needle) against ~s (haystack)~n",
+ [N,H]),
+ io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n",
+ [A,B,C,D]),
+ exit(mismatch)
+ end.
+
+do_random_match_comp(0,_,_) ->
+ ok;
+do_random_match_comp(N,NeedleRange,HaystackRange) ->
+ Needle = random_string(NeedleRange),
+ Haystack = random_string(HaystackRange),
+ true = do_match_comp(Needle,Haystack),
+ do_random_match_comp(N-1,NeedleRange,HaystackRange).
+
+do_random_match_comp2(0,_,_) ->
+ ok;
+do_random_match_comp2(N,NeedleRange,HaystackRange) ->
+ Haystack = random_string(HaystackRange),
+ Needle = random_substring(NeedleRange,Haystack),
+ true = do_match_comp(Needle,Haystack),
+ do_random_match_comp2(N-1,NeedleRange,HaystackRange).
+
+do_random_match_comp3(0,_,_) ->
+ ok;
+do_random_match_comp3(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Haystack = random_string(HaystackRange),
+ Needles = [random_substring(NeedleRange,Haystack) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ true = do_match_comp3(Needles,Haystack),
+ do_random_match_comp3(N-1,NeedleRange,HaystackRange).
+
+do_random_match_comp4(0,_,_) ->
+ ok;
+do_random_match_comp4(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Haystack = random_string(HaystackRange),
+ Needles = [random_string(NeedleRange) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ true = do_match_comp3(Needles,Haystack),
+ do_random_match_comp4(N-1,NeedleRange,HaystackRange).
+
+do_match_comp(N,H) ->
+ A = ?MASK_ERROR(binref:match(H,N)),
+ B = ?MASK_ERROR(binref:match(H,binref:compile_pattern([N]))),
+ C = ?MASK_ERROR(binary:match(make_unaligned(H),N)),
+ D = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))),
+ E = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))),
+ if
+ A =/= nomatch ->
+ put(success_counter,get(success_counter)+1);
+ true ->
+ ok
+ end,
+ case {(A =:= B), (B =:= C),(C =:= D),(D =:= E)} of
+ {true,true,true,true} ->
+ true;
+ _ ->
+ io:format("Failed to match ~s (needle) against ~s (haystack)~n",
+ [N,H]),
+ io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p,E:~p.~n",
+ [A,B,C,D,E]),
+ exit(mismatch)
+ end.
+
+do_match_comp3(N,H) ->
+ A = ?MASK_ERROR(binref:match(H,N)),
+ B = ?MASK_ERROR(binref:match(H,binref:compile_pattern(N))),
+ C = ?MASK_ERROR(binary:match(H,N)),
+ D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))),
+ if
+ A =/= nomatch ->
+ put(success_counter,get(success_counter)+1);
+ true ->
+ ok
+ end,
+ case {(A =:= B), (B =:= C),(C =:= D)} of
+ {true,true,true} ->
+ true;
+ _ ->
+ io:format("Failed to match ~s (needle) against ~s (haystack)~n",
+ [N,H]),
+ io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n",
+ [A,B,C,D]),
+ exit(mismatch)
+ end.
+
+do_random_split_comp(0,_,_) ->
+ ok;
+do_random_split_comp(N,NeedleRange,HaystackRange) ->
+ Haystack = random_string(HaystackRange),
+ Needle = random_substring(NeedleRange,Haystack),
+ true = do_split_comp(Needle,Haystack,[]),
+ true = do_split_comp(Needle,Haystack,[global]),
+ true = do_split_comp(Needle,Haystack,[global,trim]),
+ do_random_split_comp(N-1,NeedleRange,HaystackRange).
+do_random_split_comp2(0,_,_) ->
+ ok;
+do_random_split_comp2(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Haystack = random_string(HaystackRange),
+ Needles = [random_substring(NeedleRange,Haystack) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ true = do_split_comp(Needles,Haystack,[]),
+ true = do_split_comp(Needles,Haystack,[global]),
+ do_random_split_comp2(N-1,NeedleRange,HaystackRange).
+
+do_split_comp(N,H,Opts) ->
+ A = ?MASK_ERROR(binref:split(H,N,Opts)),
+ D = ?MASK_ERROR(binary:split(H,binary:compile_pattern(N),Opts)),
+ if
+ (A =/= [N]) and is_list(A) ->
+ put(success_counter,get(success_counter)+1);
+ true ->
+ ok
+ end,
+ case (A =:= D) of
+ true ->
+ true;
+ _ ->
+ io:format("Failed to split ~n~p ~n(haystack) with ~n~p ~n(needle) "
+ "~nand options ~p~n",
+ [H,N,Opts]),
+ io:format("A:~p,D:~p.~n",
+ [A,D]),
+ exit(mismatch)
+ end.
+
+do_random_replace_comp(0,_,_) ->
+ ok;
+do_random_replace_comp(N,NeedleRange,HaystackRange) ->
+ Haystack = random_string(HaystackRange),
+ Needle = random_substring(NeedleRange,Haystack),
+ Repl = random_string(NeedleRange),
+ Insertat = random_length(NeedleRange), %Sometimes larger than Repl
+ true = do_replace_comp(Needle,Haystack,Repl,[]),
+ true = do_replace_comp(Needle,Haystack,Repl,[global]),
+ true = do_replace_comp(Needle,Haystack,Repl,
+ [global,{insert_replaced,Insertat}]),
+ do_random_replace_comp(N-1,NeedleRange,HaystackRange).
+do_random_replace_comp2(0,_,_) ->
+ ok;
+do_random_replace_comp2(N,NeedleRange,HaystackRange) ->
+ NumNeedles = element(2,HaystackRange) div element(2,NeedleRange),
+ Haystack = random_string(HaystackRange),
+ Needles = [random_substring(NeedleRange,Haystack) ||
+ _ <- lists:duplicate(NumNeedles,a)],
+ Repl = random_string(NeedleRange),
+ Insertat = random_length(NeedleRange), %Sometimes larger than Repl
+ true = do_replace_comp(Needles,Haystack,Repl,[]),
+ true = do_replace_comp(Needles,Haystack,Repl,[global]),
+ true = do_replace_comp(Needles,Haystack,Repl,
+ [global,{insert_replaced,Insertat}]),
+ do_random_replace_comp2(N-1,NeedleRange,HaystackRange).
+
+do_replace_comp(N,H,R,Opts) ->
+ A = ?MASK_ERROR(binref:replace(H,N,R,Opts)),
+ D = ?MASK_ERROR(binary:replace(H,binary:compile_pattern(N),R,Opts)),
+ if
+ (A =/= N) and is_binary(A) ->
+ put(success_counter,get(success_counter)+1);
+ true ->
+ ok
+ end,
+ case (A =:= D) of
+ true ->
+ true;
+ _ ->
+ io:format("Failed to replace ~s (haystack) by ~s (needle) "
+ "inserting ~s (replacement) and options ~p~n",
+ [H,N,R,Opts]),
+ io:format("A:~p,D:~p.~n",
+ [A,D]),
+ exit(mismatch)
+ end.
+
+one_random_number(N) ->
+ M = ((N - 1) rem 10) + 1,
+ element(M,{$0,$1,$2,$3,$4,$5,$6,$7,$8,$9}).
+
+one_random(N) ->
+ M = ((N - 1) rem 68) + 1,
+ element(M,{$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,
+ $u,$v,$w,$x,$y,$z,$�,$�,$�,$A,$B,$C,$D,$E,$F,$G,$H,
+ $I,$J,$K,$L,$M,$N,$O,$P,$Q,$R,$S,$T,$U,$V,$W,$X,$Y,$Z,$�,
+ $�,$�,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9}).
+
+random_number({Min,Max}) -> % Min and Max are *length* of number in
+ % decimal positions
+ X = random:uniform(Max - Min + 1) + Min - 1,
+ list_to_integer([one_random_number(random:uniform(10)) || _ <- lists:seq(1,X)]).
+
+
+random_length({Min,Max}) ->
+ random:uniform(Max - Min + 1) + Min - 1.
+random_string({Min,Max}) ->
+ X = random:uniform(Max - Min + 1) + Min - 1,
+ list_to_binary([one_random(random:uniform(68)) || _ <- lists:seq(1,X)]).
+random_substring({Min,Max},Hay) ->
+ X = random:uniform(Max - Min + 1) + Min - 1,
+ Y = byte_size(Hay),
+ Z = if
+ X > Y -> Y;
+ true -> X
+ end,
+ PMax = Y - Z,
+ Pos = random:uniform(PMax + 1) - 1,
+ <<_:Pos/binary,Res:Z/binary,_/binary>> = Hay,
+ Res.
+
+mask_error({'EXIT',{Err,_}}) ->
+ Err;
+mask_error(Else) ->
+ Else.
+
+make_unaligned(Bin0) when is_binary(Bin0) ->
+ Bin1 = <<0:3,Bin0/binary,31:5>>,
+ Sz = byte_size(Bin0),
+ <<0:3,Bin:Sz/binary,31:5>> = id(Bin1),
+ Bin.
+make_unaligned2(Bin0) when is_binary(Bin0) ->
+ Bin1 = <<31:5,Bin0/binary,0:3>>,
+ Sz = byte_size(Bin0),
+ <<31:5,Bin:Sz/binary,0:3>> = id(Bin1),
+ Bin.
+
+id(I) -> I.
diff --git a/lib/stdlib/test/binref.erl b/lib/stdlib/test/binref.erl
new file mode 100644
index 0000000000..6d96736ef3
--- /dev/null
+++ b/lib/stdlib/test/binref.erl
@@ -0,0 +1,588 @@
+-module(binref).
+
+-export([compile_pattern/1,match/2,match/3,matches/2,matches/3,
+ split/2,split/3,replace/3,replace/4,first/1,last/1,at/2,
+ part/2,part/3,copy/1,copy/2,encode_unsigned/1,encode_unsigned/2,
+ decode_unsigned/1,decode_unsigned/2,referenced_byte_size/1,
+ longest_common_prefix/1,longest_common_suffix/1,bin_to_list/1,
+ bin_to_list/2,bin_to_list/3,list_to_bin/1]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% compile_pattern, a dummy
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+compile_pattern(Pattern) when is_binary(Pattern) ->
+ {[Pattern]};
+compile_pattern(Pattern) ->
+ try
+ [ true = is_binary(P) || P <- Pattern ],
+ {Pattern}
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% match and matches
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+match(H,N) ->
+ match(H,N,[]).
+match(Haystack,Needle,Options) when is_binary(Needle) ->
+ match(Haystack,[Needle],Options);
+match(Haystack,{Needles},Options) ->
+ match(Haystack,Needles,Options);
+match(Haystack,Needles,Options) ->
+ try
+ true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause
+ case get_opts_match(Options,nomatch) of
+ nomatch ->
+ mloop(Haystack,Needles);
+ {A,B} when B > 0 ->
+ <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack,
+ mloop(SubStack,Needles,A,B+A);
+ {A,B} when B < 0 ->
+ Start = A + B,
+ Len = -B,
+ <<_:Start/binary,SubStack:Len/binary,_/binary>> = Haystack,
+ mloop(SubStack,Needles,Start,Len+Start);
+ _ ->
+ nomatch
+ end
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+matches(H,N) ->
+ matches(H,N,[]).
+matches(Haystack,Needle,Options) when is_binary(Needle) ->
+ matches(Haystack,[Needle],Options);
+matches(Haystack,{Needles},Options) ->
+ matches(Haystack,Needles,Options);
+matches(Haystack,Needles,Options) ->
+ try
+ true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause
+ case get_opts_match(Options,nomatch) of
+ nomatch ->
+ msloop(Haystack,Needles);
+ {A,B} when B > 0 ->
+ <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack,
+ msloop(SubStack,Needles,A,B+A);
+ {A,B} when B < 0 ->
+ Start = A + B,
+ Len = -B,
+ <<_:Start/binary,SubStack:Len/binary,_/binary>> = Haystack,
+ msloop(SubStack,Needles,Start,Len+Start);
+ _ ->
+ []
+ end
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+mloop(Haystack,Needles) ->
+ mloop(Haystack,Needles,0,byte_size(Haystack)).
+
+mloop(_Haystack,_Needles,N,M) when N >= M ->
+ nomatch;
+mloop(Haystack,Needles,N,M) ->
+ case mloop2(Haystack,Needles,N,nomatch) of
+ nomatch ->
+ % Not found
+ <<_:8,NewStack/binary>> = Haystack,
+ mloop(NewStack,Needles,N+1,M);
+ {N,Len} ->
+ {N,Len}
+ end.
+
+msloop(Haystack,Needles) ->
+ msloop(Haystack,Needles,0,byte_size(Haystack)).
+
+msloop(_Haystack,_Needles,N,M) when N >= M ->
+ [];
+msloop(Haystack,Needles,N,M) ->
+ case mloop2(Haystack,Needles,N,nomatch) of
+ nomatch ->
+ % Not found
+ <<_:8,NewStack/binary>> = Haystack,
+ msloop(NewStack,Needles,N+1,M);
+ {N,Len} ->
+ NewN = N+Len,
+ if
+ NewN >= M ->
+ [{N,Len}];
+ true ->
+ <<_:Len/binary,NewStack/binary>> = Haystack,
+ [{N,Len} | msloop(NewStack,Needles,NewN,M)]
+ end
+ end.
+
+mloop2(_Haystack,[],_N,Res) ->
+ Res;
+mloop2(Haystack,[Needle|Tail],N,Candidate) ->
+ NS = byte_size(Needle),
+ case Haystack of
+ <<Needle:NS/binary,_/binary>> ->
+ NewCandidate = case Candidate of
+ nomatch ->
+ {N,NS};
+ {N,ONS} when ONS < NS ->
+ {N,NS};
+ Better ->
+ Better
+ end,
+ mloop2(Haystack,Tail,N,NewCandidate);
+ _ ->
+ mloop2(Haystack,Tail,N,Candidate)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% split
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+split(H,N) ->
+ split(H,N,[]).
+split(Haystack,{Needles},Options) ->
+ split(Haystack, Needles, Options);
+split(Haystack,Needles0,Options) ->
+ try
+ Needles = if
+ is_list(Needles0) ->
+ Needles0;
+ is_binary(Needles0) ->
+ [Needles0];
+ true ->
+ exit(badtype)
+ end,
+ {Part,Global,Trim} = get_opts_split(Options,{nomatch,false,false}),
+ {Start,End,NewStack} =
+ case Part of
+ nomatch ->
+ {0,byte_size(Haystack),Haystack};
+ {A,B} when B >= 0 ->
+ <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack,
+ {A,A+B,SubStack};
+ {A,B} when B < 0 ->
+ S = A + B,
+ L = -B,
+ <<_:S/binary,SubStack:L/binary,_/binary>> = Haystack,
+ {S,S+L,SubStack}
+ end,
+ MList = if
+ Global ->
+ msloop(NewStack,Needles,Start,End);
+ true ->
+ case mloop(NewStack,Needles,Start,End) of
+ nomatch ->
+ [];
+ X ->
+ [X]
+ end
+ end,
+ do_split(Haystack,MList,0,Trim)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_split(H,[],N,true) when N >= byte_size(H) ->
+ [];
+do_split(H,[],N,_) ->
+ [part(H,{N,byte_size(H)-N})];
+do_split(H,[{A,B}|T],N,Trim) ->
+ case part(H,{N,A-N}) of
+ <<>> ->
+ Rest = do_split(H,T,A+B,Trim),
+ case {Trim, Rest} of
+ {true,[]} ->
+ [];
+ _ ->
+ [<<>> | Rest]
+ end;
+ Oth ->
+ [Oth | do_split(H,T,A+B,Trim)]
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% replace
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+replace(H,N,R) ->
+ replace(H,N,R,[]).
+replace(Haystack,{Needles},Replacement,Options) ->
+ replace(Haystack,Needles,Replacement,Options);
+
+replace(Haystack,Needles0,Replacement,Options) ->
+ try
+ Needles = if
+ is_list(Needles0) ->
+ Needles0;
+ is_binary(Needles0) ->
+ [Needles0];
+ true ->
+ exit(badtype)
+ end,
+ true = is_binary(Replacement), % Make badarg instead of function clause
+ {Part,Global,Insert} = get_opts_replace(Options,{nomatch,false,[]}),
+ {Start,End,NewStack} =
+ case Part of
+ nomatch ->
+ {0,byte_size(Haystack),Haystack};
+ {A,B} when B >= 0 ->
+ <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack,
+ {A,A+B,SubStack};
+ {A,B} when B < 0 ->
+ S = A + B,
+ L = -B,
+ <<_:S/binary,SubStack:L/binary,_/binary>> = Haystack,
+ {S,S+L,SubStack}
+ end,
+ MList = if
+ Global ->
+ msloop(NewStack,Needles,Start,End);
+ true ->
+ case mloop(NewStack,Needles,Start,End) of
+ nomatch ->
+ [];
+ X ->
+ [X]
+ end
+ end,
+ ReplList = case Insert of
+ [] ->
+ Replacement;
+ Y when is_integer(Y) ->
+ splitat(Replacement,0,[Y]);
+ Li when is_list(Li) ->
+ splitat(Replacement,0,lists:sort(Li))
+ end,
+ erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0))
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+
+do_replace(H,[],_,N) ->
+ [part(H,{N,byte_size(H)-N})];
+do_replace(H,[{A,B}|T],Replacement,N) ->
+ [part(H,{N,A-N}),
+ if
+ is_list(Replacement) ->
+ do_insert(Replacement, part(H,{A,B}));
+ true ->
+ Replacement
+ end
+ | do_replace(H,T,Replacement,A+B)].
+
+do_insert([X],_) ->
+ [X];
+do_insert([H|T],R) ->
+ [H,R|do_insert(T,R)].
+
+splitat(H,N,[]) ->
+ [part(H,{N,byte_size(H)-N})];
+splitat(H,N,[I|T]) ->
+ [part(H,{N,I-N})|splitat(H,I,T)].
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% first, last and at
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+first(Subject) ->
+ try
+ <<A:8,_/binary>> = Subject,
+ A
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+last(Subject) ->
+ try
+ N = byte_size(Subject) - 1,
+ <<_:N/binary,A:8>> = Subject,
+ A
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+at(Subject,X) ->
+ try
+ <<_:X/binary,A:8,_/binary>> = Subject,
+ A
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% bin_to_list
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+bin_to_list(Subject) ->
+ try
+ binary_to_list(Subject)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+bin_to_list(Subject,T) ->
+ try
+ {A0,B0} = T,
+ {A,B} = if
+ B0 < 0 ->
+ {A0+B0,-B0};
+ true ->
+ {A0,B0}
+ end,
+ binary_to_list(Subject,A+1,A+B)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+bin_to_list(Subject,A,B) ->
+ try
+ bin_to_list(Subject,{A,B})
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% list_to_bin
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+list_to_bin(List) ->
+ try
+ erlang:list_to_binary(List)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% longest_common_prefix
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+longest_common_prefix(LB) ->
+ try
+ true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause
+ do_longest_common_prefix(LB,0)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_longest_common_prefix(LB,X) ->
+ case do_lcp(LB,X,no) of
+ true ->
+ do_longest_common_prefix(LB,X+1);
+ false ->
+ X
+ end.
+do_lcp([],_,_) ->
+ true;
+do_lcp([Bin|_],X,_) when byte_size(Bin) =< X ->
+ false;
+do_lcp([Bin|T],X,no) ->
+ Ch = at(Bin,X),
+ do_lcp(T,X,Ch);
+do_lcp([Bin|T],X,Ch) ->
+ Ch2 = at(Bin,X),
+ if
+ Ch =:= Ch2 ->
+ do_lcp(T,X,Ch);
+ true ->
+ false
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% longest_common_suffix
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+longest_common_suffix(LB) ->
+ try
+ true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause
+ do_longest_common_suffix(LB,0)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_longest_common_suffix(LB,X) ->
+ case do_lcs(LB,X,no) of
+ true ->
+ do_longest_common_suffix(LB,X+1);
+ false ->
+ X
+ end.
+do_lcs([],_,_) ->
+ true;
+do_lcs([Bin|_],X,_) when byte_size(Bin) =< X ->
+ false;
+do_lcs([Bin|T],X,no) ->
+ Ch = at(Bin,byte_size(Bin) - 1 - X),
+ do_lcs(T,X,Ch);
+do_lcs([Bin|T],X,Ch) ->
+ Ch2 = at(Bin,byte_size(Bin) - 1 - X),
+ if
+ Ch =:= Ch2 ->
+ do_lcs(T,X,Ch);
+ true ->
+ false
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% part
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+part(Subject,Part) ->
+ try
+ do_part(Subject,Part)
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+part(Subject,Pos,Len) ->
+ part(Subject,{Pos,Len}).
+
+do_part(Bin,{A,B}) when B >= 0 ->
+ <<_:A/binary,Sub:B/binary,_/binary>> = Bin,
+ Sub;
+do_part(Bin,{A,B}) when B < 0 ->
+ S = A + B,
+ L = -B,
+ <<_:S/binary,Sub:L/binary,_/binary>> = Bin,
+ Sub.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% copy
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+copy(Subject) ->
+ copy(Subject,1).
+copy(Subject,N) ->
+ try
+ true = is_integer(N) and (N >= 0) and is_binary(Subject), % Badarg, not function clause
+ erlang:list_to_binary(lists:duplicate(N,Subject))
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% encode_unsigned
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+encode_unsigned(Unsigned) ->
+ encode_unsigned(Unsigned,big).
+encode_unsigned(Unsigned,Endian) ->
+ try
+ true = is_integer(Unsigned) and (Unsigned >= 0),
+ if
+ Unsigned =:= 0 ->
+ <<0>>;
+ true ->
+ case Endian of
+ big ->
+ list_to_binary(do_encode(Unsigned,[]));
+ little ->
+ list_to_binary(do_encode_r(Unsigned))
+ end
+ end
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_encode(0,L) ->
+ L;
+do_encode(N,L) ->
+ Byte = N band 255,
+ NewN = N bsr 8,
+ do_encode(NewN,[Byte|L]).
+
+do_encode_r(0) ->
+ [];
+do_encode_r(N) ->
+ Byte = N band 255,
+ NewN = N bsr 8,
+ [Byte|do_encode_r(NewN)].
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% decode_unsigned
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+decode_unsigned(Subject) ->
+ decode_unsigned(Subject,big).
+
+decode_unsigned(Subject,Endian) ->
+ try
+ true = is_binary(Subject),
+ case Endian of
+ big ->
+ do_decode(Subject,0);
+ little ->
+ do_decode_r(Subject,0)
+ end
+ catch
+ _:_ ->
+ erlang:error(badarg)
+ end.
+
+do_decode(<<>>,N) ->
+ N;
+do_decode(<<X:8,Bin/binary>>,N) ->
+ do_decode(Bin,(N bsl 8) bor X).
+
+do_decode_r(<<>>,N) ->
+ N;
+do_decode_r(Bin,N) ->
+ Sz = byte_size(Bin) - 1,
+ <<NewBin:Sz/binary,X>> = Bin,
+ do_decode_r(NewBin, (N bsl 8) bor X).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% referenced_byte_size cannot
+%% be implemented in pure
+%% erlang
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+referenced_byte_size(Bin) when is_binary(Bin) ->
+ erlang:error(not_implemented);
+referenced_byte_size(_) ->
+ erlang:error(badarg).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Simple helper functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Option "parsing"
+get_opts_match([],Part) ->
+ Part;
+get_opts_match([{scope,{A,B}} | T],_Part) ->
+ get_opts_match(T,{A,B});
+get_opts_match(_,_) ->
+ throw(badopt).
+
+get_opts_split([],{Part,Global,Trim}) ->
+ {Part,Global,Trim};
+get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) ->
+ get_opts_split(T,{{A,B},Global,Trim});
+get_opts_split([global | T],{Part,_Global,Trim}) ->
+ get_opts_split(T,{Part,true,Trim});
+get_opts_split([trim | T],{Part,Global,_Trim}) ->
+ get_opts_split(T,{Part,Global,true});
+get_opts_split(_,_) ->
+ throw(badopt).
+
+get_opts_replace([],{Part,Global,Insert}) ->
+ {Part,Global,Insert};
+get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) ->
+ get_opts_replace(T,{{A,B},Global,Insert});
+get_opts_replace([global | T],{Part,_Global,Insert}) ->
+ get_opts_replace(T,{Part,true,Insert});
+get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) ->
+ get_opts_replace(T,{Part,Global,N});
+get_opts_replace(_,_) ->
+ throw(badopt).