aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/configure.in5
-rw-r--r--erts/emulator/Makefile.in6
-rw-r--r--erts/emulator/beam/beam_debug.c119
-rw-r--r--erts/emulator/beam/beam_emu.c1235
-rw-r--r--erts/emulator/beam/beam_load.c521
-rw-r--r--erts/emulator/beam/bif.tab1
-rw-r--r--erts/emulator/beam/ops.tab269
-rw-r--r--erts/emulator/drivers/common/efile_drv.c5
-rw-r--r--erts/emulator/test/beam_SUITE.erl21
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl45
-rw-r--r--erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S80
-rw-r--r--erts/emulator/test/erts_debug_SUITE.erl9
-rwxr-xr-xerts/emulator/utils/beam_makeops118
-rwxr-xr-xerts/emulator/utils/count127
-rw-r--r--erts/epmd/src/epmd_srv.c8
-rw-r--r--lib/erl_interface/doc/src/ei.xml2
-rw-r--r--lib/erl_interface/include/ei.h29
-rw-r--r--lib/erl_interface/src/connect/ei_connect.c1
-rw-r--r--lib/erl_interface/src/legacy/erl_marshal.c13
-rw-r--r--lib/erl_interface/src/legacy/global_register.c12
-rw-r--r--lib/erl_interface/src/legacy/global_unregister.c12
-rw-r--r--lib/erl_interface/src/misc/ei_format.c18
-rw-r--r--lib/erl_interface/test/Makefile1
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE.erl19
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c23
-rw-r--r--lib/erl_interface/test/ei_format_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c2
-rw-r--r--lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c12
-rw-r--r--lib/erl_interface/test/erl_global_SUITE.erl133
-rw-r--r--lib/erl_interface/test/erl_global_SUITE_data/Makefile.first21
-rw-r--r--lib/erl_interface/test/erl_global_SUITE_data/Makefile.src41
-rw-r--r--lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c263
-rw-r--r--lib/erl_interface/test/port_call_SUITE.erl2
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl4
-rw-r--r--lib/ssl/doc/src/ssl.xml20
-rw-r--r--lib/ssl/src/ssl.erl36
-rw-r--r--lib/ssl/src/ssl_connection.erl56
-rw-r--r--lib/ssl/src/ssl_internal.hrl3
-rw-r--r--lib/stdlib/src/base64.erl113
-rw-r--r--lib/stdlib/src/c.erl52
-rw-r--r--lib/stdlib/src/erl_posix_msg.erl285
-rw-r--r--lib/stdlib/test/base64_SUITE.erl89
42 files changed, 2678 insertions, 1155 deletions
diff --git a/erts/configure.in b/erts/configure.in
index 6e983a07b0..627f734409 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -580,6 +580,11 @@ AC_SUBST(WFLAGS)
AC_SUBST(CFLAG_RUNTIME_LIBRARY_PATH)
AC_CHECK_SIZEOF(void *) # Needed for ARCH and smp checks below
+if test "x$ac_cv_sizeof_void_p" = x8; then
+ AC_SUBST(EXTERNAL_WORD_SIZE, 64)
+else
+ AC_SUBST(EXTERNAL_WORD_SIZE, 32)
+fi
dnl
dnl Figure out operating system and cpu architecture
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 6c33e2ca16..f04df354a8 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -505,8 +505,10 @@ ifdef HIPE_ENABLED
OPCODE_TABLES += hipe/hipe_ops.tab
endif
-$(TTF_DIR)/beam_opcodes.h $(TTF_DIR)/beam_opcodes.c: $(OPCODE_TABLES)
- LANG=C $(PERL) utils/beam_makeops -outdir $(TTF_DIR) \
+$(TTF_DIR)/beam_opcodes.h $(TTF_DIR)/beam_opcodes.c: $(OPCODE_TABLES) utils/beam_makeops
+ LANG=C $(PERL) utils/beam_makeops \
+ -wordsize @EXTERNAL_WORD_SIZE@ \
+ -outdir $(TTF_DIR) \
-emulator $(OPCODE_TABLES)
# bif and atom table
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index b0bf14b94f..2855241b91 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -48,7 +48,6 @@
void dbg_bt(Process* p, Eterm* sp);
void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg);
-static void print_big(int to, void *to_arg, Eterm* addr);
static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr);
Eterm
erts_debug_same_2(Process* p, Eterm term1, Eterm term2)
@@ -157,6 +156,25 @@ void debug_dump_code(BeamInstr *I, int num)
}
#endif
+BIF_RETTYPE
+erts_debug_instructions_0(BIF_ALIST_0)
+{
+ int i = 0;
+ Uint needed = num_instructions * 2;
+ Eterm* hp;
+ Eterm res = NIL;
+
+ for (i = 0; i < num_instructions; i++) {
+ needed += 2*strlen(opc[i].name);
+ }
+ hp = HAlloc(BIF_P, needed);
+ for (i = num_instructions-1; i >= 0; i--) {
+ Eterm s = erts_bld_string_n(&hp, 0, opc[i].name, strlen(opc[i].name));
+ res = erts_bld_cons(&hp, 0, s, res);
+ }
+ return res;
+}
+
Eterm
erts_debug_disassemble_1(Process* p, Eterm addr)
{
@@ -312,6 +330,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
BeamInstr packed = 0; /* Accumulator for packed operations. */
BeamInstr args[8]; /* Arguments for this instruction. */
BeamInstr* ap; /* Pointer to arguments. */
+ BeamInstr* unpacked; /* Unpacked arguments */
start_prog = opc[op].pack;
@@ -360,6 +379,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
*ap++ = packed & BEAM_LOOSE_MASK;
packed >>= BEAM_LOOSE_SHIFT;
break;
+#ifdef ARCH_64
+ case 'w': /* Shift 32 steps */
+ *ap++ = packed & BEAM_WIDE_MASK;
+ packed >>= BEAM_WIDE_SHIFT;
+ break;
+#endif
case 'p':
*sp++ = *--ap;
break;
@@ -386,7 +411,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
break;
case 'x': /* x(N) */
if (reg_index(ap[0]) == 0) {
- erts_print(to, to_arg, "X[0]");
+ erts_print(to, to_arg, "x[0]");
} else {
erts_print(to, to_arg, "x(%d)", reg_index(ap[0]));
}
@@ -506,6 +531,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
ap++;
break;
case 'P': /* Byte offset into tuple (see beam_load.c) */
+ case 'Q': /* Like 'P', but packable */
erts_print(to, to_arg, "%d", (*ap / sizeof(Eterm)) - 1);
ap++;
break;
@@ -526,9 +552,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
* Print more information about certain instructions.
*/
+ unpacked = ap;
ap = addr + size;
switch (op) {
- case op_i_select_val_sfI:
+ case op_i_select_val_rfI:
+ case op_i_select_val_xfI:
+ case op_i_select_val_yfI:
{
int n = ap[-1];
@@ -540,7 +569,24 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_jump_on_val_sfII:
+ case op_i_select_tuple_arity_rfI:
+ case op_i_select_tuple_arity_xfI:
+ case op_i_select_tuple_arity_yfI:
+ {
+ int n = ap[-1];
+
+ while (n > 0) {
+ Uint arity = arityval(ap[0]);
+ erts_print(to, to_arg, " {%d} f(" HEXF ")", arity, ap[1]);
+ ap += 2;
+ size += 2;
+ n--;
+ }
+ }
+ break;
+ case op_i_jump_on_val_rfII:
+ case op_i_jump_on_val_xfII:
+ case op_i_jump_on_val_yfII:
{
int n;
for (n = ap[-2]; n > 0; n--) {
@@ -550,39 +596,46 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_select_big_sf:
- while (ap[0]) {
- Eterm *bigp = (Eterm *) ap;
- int arity = thing_arityval(*bigp);
- print_big(to, to_arg, bigp);
- size += TermWords(arity+1);
- ap += TermWords(arity+1);
- erts_print(to, to_arg, " f(" HEXF ") ", ap[0]);
- ap++;
- size++;
+ case op_i_jump_on_val_zero_rfI:
+ case op_i_jump_on_val_zero_xfI:
+ case op_i_jump_on_val_zero_yfI:
+ {
+ int n;
+ for (n = ap[-1]; n > 0; n--) {
+ erts_print(to, to_arg, "f(" HEXF ") ", ap[0]);
+ ap++;
+ size++;
+ }
+ }
+ break;
+ case op_i_put_tuple_rI:
+ case op_i_put_tuple_xI:
+ case op_i_put_tuple_yI:
+ {
+ int n = unpacked[-1];
+
+ while (n > 0) {
+ if (!is_header(ap[0])) {
+ erts_print(to, to_arg, " %T", (Eterm) ap[0]);
+ } else {
+ switch ((ap[0] >> 2) & 0x03) {
+ case R_REG_DEF:
+ erts_print(to, to_arg, " x(0)");
+ break;
+ case X_REG_DEF:
+ erts_print(to, to_arg, " x(%d)", ap[0] >> 4);
+ break;
+ case Y_REG_DEF:
+ erts_print(to, to_arg, " y(%d)", ap[0] >> 4);
+ break;
+ }
+ }
+ ap++, size++, n--;
+ }
}
- ap++;
- size++;
break;
}
erts_print(to, to_arg, "\n");
return size;
}
-
-static void
-print_big(int to, void *to_arg, Eterm* addr)
-{
- int i;
- int k;
-
- i = BIG_SIZE(addr);
- if (BIG_SIGN(addr))
- erts_print(to, to_arg, "-#integer(%d) = {", i);
- else
- erts_print(to, to_arg, "#integer(%d) = {", i);
- erts_print(to, to_arg, "0x%x", BIG_DIGIT(addr, 0));
- for (k = 1; k < i; k++)
- erts_print(to, to_arg, ",0x%x", BIG_DIGIT(addr, k));
- erts_print(to, to_arg, "}");
-}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 8a0e12dd4f..16741aa2d7 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -344,6 +344,8 @@ extern int count_instructions;
#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N)))
#define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N)))
+#define Qb(N) (N)
+#define Ib(N) (N)
#define x(N) reg[N]
#define y(N) E[N]
#define r(N) x##N
@@ -472,6 +474,13 @@ extern int count_instructions;
HEAP_SPACE_VERIFIED(need); \
} while (0)
+#define TestHeapPutList(Need, Reg) \
+ do { \
+ TestHeap((Need), 1); \
+ PutList(Reg, r(0), r(0), StoreSimpleDest); \
+ CHECK_TERM(r(0)); \
+ } while (0)
+
#ifdef HYBRID
#ifdef INCREMENTAL
#define TestGlobalHeap(Nh, Live, hp) \
@@ -516,6 +525,11 @@ extern int count_instructions;
SWAPIN; \
} while (0)
+#define PutTuple(Dst, Arity) \
+ do { \
+ Dst = make_tuple(HTOP); \
+ pt_arity = (Arity); \
+ } while (0)
/*
* Check that we haven't used the reductions and jump to function pointed to by
@@ -674,6 +688,11 @@ extern int count_instructions;
SET_I((BeamInstr *) CallDest); \
Dispatch();
+#define MoveJump(Src) \
+ r(0) = (Src); \
+ SET_I((BeamInstr *) Arg(0)); \
+ Goto(*I);
+
#define GetList(Src, H, T) do { \
Eterm* tmp_ptr = list_val(Src); \
H = CAR(tmp_ptr); \
@@ -723,16 +742,8 @@ extern int count_instructions;
(Dest) = (* (Eterm *) EXPAND_POINTER(tmp_arg1)); \
} while (0)
-#define PutTuple(Arity, Src, Dest) \
- ASSERT(is_arity_value(Arity)); \
- Dest = make_tuple(HTOP); \
- HTOP[0] = (Arity); \
- HTOP[1] = (Src); \
- HTOP += 2
-
-#define Put(Word) *HTOP++ = (Word)
-
#define EqualImmed(X, Y, Action) if (X != Y) { Action; }
+#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; }
#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; }
@@ -984,8 +995,41 @@ extern int count_instructions;
#define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; }
#define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; }
-static BifFunction translate_gc_bif(void* gcf);
-static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf);
+/*
+ * process_main() is already huge, so we want to avoid inlining
+ * into it. Especially functions that are seldom used.
+ */
+#ifdef __GNUC__
+# define NOINLINE __attribute__((__noinline__))
+#else
+# define NOINLINE
+#endif
+
+/*
+ * The following functions are called directly by process_main().
+ * Don't inline them.
+ */
+static BifFunction translate_gc_bif(void* gcf) NOINLINE;
+static BeamInstr* handle_error(Process* c_p, BeamInstr* pc,
+ Eterm* reg, BifFunction bf) NOINLINE;
+static BeamInstr* call_error_handler(Process* p, BeamInstr* ip,
+ Eterm* reg, Eterm func) NOINLINE;
+static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity) NOINLINE;
+static BeamInstr* apply(Process* p, Eterm module, Eterm function,
+ Eterm args, Eterm* reg) NOINLINE;
+static int hibernate(Process* c_p, Eterm module, Eterm function,
+ Eterm args, Eterm* reg) NOINLINE;
+static BeamInstr* call_fun(Process* p, int arity,
+ Eterm* reg, Eterm args) NOINLINE;
+static BeamInstr* apply_fun(Process* p, Eterm fun,
+ Eterm args, Eterm* reg) NOINLINE;
+static Eterm new_fun(Process* p, Eterm* reg,
+ ErlFunEntry* fe, int num_free) NOINLINE;
+
+
+/*
+ * Functions not directly called by process_main(). OK to inline.
+ */
static BeamInstr* next_catch(Process* c_p, Eterm *reg);
static void terminate_proc(Process* c_p, Eterm Value);
static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc);
@@ -993,16 +1037,6 @@ static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg,
BifFunction bf, Eterm args);
static struct StackTrace * get_trace_from_exc(Eterm exc);
static Eterm make_arglist(Process* c_p, Eterm* reg, int a);
-static Eterm call_error_handler(Process* p, BeamInstr* ip, Eterm* reg);
-static Eterm call_breakpoint_handler(Process* p, BeamInstr* fi, Eterm* reg);
-static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity);
-static BeamInstr* apply(Process* p, Eterm module, Eterm function,
- Eterm args, Eterm* reg);
-static int hibernate(Process* c_p, Eterm module, Eterm function,
- Eterm args, Eterm* reg);
-static BeamInstr* call_fun(Process* p, int arity, Eterm* reg, Eterm args);
-static BeamInstr* apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg);
-static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free);
#if defined(VXWORKS)
static int init_done;
@@ -1146,6 +1180,8 @@ void process_main(void)
Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */
+ Eterm pt_arity; /* Used by do_put_tuple */
+
ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */
@@ -1246,6 +1282,52 @@ void process_main(void)
#define STORE_ARITH_RESULT(res) StoreBifResult(2, (res));
#define ARITH_FUNC(name) erts_gc_##name
+ {
+ Eterm increment_reg_val;
+ Eterm increment_val;
+ Uint live;
+ Eterm result;
+
+ OpCase(i_increment_yIId):
+ increment_reg_val = yb(Arg(0));
+ goto do_increment;
+
+ OpCase(i_increment_xIId):
+ increment_reg_val = xb(Arg(0));
+ goto do_increment;
+
+ OpCase(i_increment_rIId):
+ increment_reg_val = r(0);
+ I--;
+
+ do_increment:
+ increment_val = Arg(1);
+ if (is_small(increment_reg_val)) {
+ Sint i = signed_val(increment_reg_val) + increment_val;
+ ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
+ if (MY_IS_SSMALL(i)) {
+ result = make_small(i);
+ store_result:
+ StoreBifResult(3, result);
+ }
+ }
+
+ live = Arg(2);
+ SWAPOUT;
+ reg[0] = r(0);
+ reg[live] = increment_reg_val;
+ reg[live+1] = make_small(increment_val);
+ result = erts_gc_mixed_plus(c_p, reg, live);
+ r(0) = reg[0];
+ SWAPIN;
+ ERTS_HOLE_CHECK(c_p);
+ if (is_value(result)) {
+ goto store_result;
+ }
+ ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
+ goto find_func_info;
+ }
+
OpCase(i_plus_jId):
{
Eterm result;
@@ -1309,6 +1391,52 @@ void process_main(void)
}
Next(1);
+ {
+ Eterm is_eq_exact_lit_val;
+
+ OpCase(i_is_eq_exact_literal_xfc):
+ is_eq_exact_lit_val = xb(Arg(0));
+ I++;
+ goto do_is_eq_exact_literal;
+
+ OpCase(i_is_eq_exact_literal_yfc):
+ is_eq_exact_lit_val = yb(Arg(0));
+ I++;
+ goto do_is_eq_exact_literal;
+
+ OpCase(i_is_eq_exact_literal_rfc):
+ is_eq_exact_lit_val = r(0);
+
+ do_is_eq_exact_literal:
+ if (!eq(Arg(1), is_eq_exact_lit_val)) {
+ ClauseFail();
+ }
+ Next(2);
+ }
+
+ {
+ Eterm is_ne_exact_lit_val;
+
+ OpCase(i_is_ne_exact_literal_xfc):
+ is_ne_exact_lit_val = xb(Arg(0));
+ I++;
+ goto do_is_ne_exact_literal;
+
+ OpCase(i_is_ne_exact_literal_yfc):
+ is_ne_exact_lit_val = yb(Arg(0));
+ I++;
+ goto do_is_ne_exact_literal;
+
+ OpCase(i_is_ne_exact_literal_rfc):
+ is_ne_exact_lit_val = r(0);
+
+ do_is_ne_exact_literal:
+ if (eq(Arg(1), is_ne_exact_lit_val)) {
+ ClauseFail();
+ }
+ Next(2);
+ }
+
OpCase(i_move_call_only_fcr): {
r(0) = Arg(1);
}
@@ -1392,6 +1520,17 @@ void process_main(void)
NextPF(1, next);
}
+ OpCase(move_x1_c): {
+ x(1) = Arg(0);
+ Next(1);
+ }
+
+ OpCase(move_x2_c): {
+ x(2) = Arg(0);
+ Next(1);
+ }
+
+
OpCase(return): {
SET_I(c_p->cp);
/*
@@ -1405,16 +1544,6 @@ void process_main(void)
Goto(*I);
}
- OpCase(test_heap_1_put_list_Iy): {
- BeamInstr *next;
-
- PreFetch(2, next);
- TestHeap(Arg(0), 1);
- PutList(yb(Arg(1)), r(0), r(0), StoreSimpleDest);
- CHECK_TERM(r(0));
- NextPF(2, next);
- }
-
/*
* Send is almost a standard call-BIF with two arguments, except for:
* 1) It cannot be traced.
@@ -1447,24 +1576,36 @@ void process_main(void)
goto find_func_info;
}
- OpCase(i_element_jssd): {
- Eterm index;
- Eterm tuple;
-
- /*
- * Inlined version of element/2 for speed.
- */
- GetArg2(1, index, tuple);
- if (is_small(index) && is_tuple(tuple)) {
- Eterm* tp = tuple_val(tuple);
-
- if ((signed_val(index) >= 1) &&
- (signed_val(index) <= arityval(*tp))) {
- Eterm result = tp[signed_val(index)];
- StoreBifResult(3, result);
- }
- }
- }
+ {
+ Eterm element_index;
+ Eterm element_tuple;
+
+ OpCase(i_element_xjsd):
+ element_tuple = xb(Arg(0));
+ I++;
+ goto do_element;
+
+ OpCase(i_element_yjsd):
+ element_tuple = yb(Arg(0));
+ I++;
+ goto do_element;
+
+ OpCase(i_element_rjsd):
+ element_tuple = r(0);
+ /* Fall through */
+
+ do_element:
+ GetArg1(1, element_index);
+ if (is_small(element_index) && is_tuple(element_tuple)) {
+ Eterm* tp = tuple_val(element_tuple);
+
+ if ((signed_val(element_index) >= 1) &&
+ (signed_val(element_index) <= arityval(*tp))) {
+ Eterm result = tp[signed_val(element_index)];
+ StoreBifResult(2, result);
+ }
+ }
+ }
/* Fall through */
OpCase(badarg_j):
@@ -1472,24 +1613,32 @@ void process_main(void)
c_p->freason = BADARG;
goto lb_Cl_error;
- OpCase(i_fast_element_jIsd): {
- Eterm tuple;
-
- /*
- * Inlined version of element/2 for even more speed.
- * The first argument is an untagged integer >= 1.
- * The second argument is guaranteed to be a register operand.
- */
- GetArg1(2, tuple);
- if (is_tuple(tuple)) {
- Eterm* tp = tuple_val(tuple);
- tmp_arg2 = Arg(1);
- if (tmp_arg2 <= arityval(*tp)) {
- Eterm result = tp[tmp_arg2];
- StoreBifResult(3, result);
- }
- }
+ {
+ Eterm fast_element_tuple;
+
+ OpCase(i_fast_element_rjId):
+ fast_element_tuple = r(0);
+
+ do_fast_element:
+ if (is_tuple(fast_element_tuple)) {
+ Eterm* tp = tuple_val(fast_element_tuple);
+ Eterm pos = Arg(1); /* Untagged integer >= 1 */
+ if (pos <= arityval(*tp)) {
+ Eterm result = tp[pos];
+ StoreBifResult(2, result);
+ }
+ }
goto badarg;
+
+ OpCase(i_fast_element_xjId):
+ fast_element_tuple = xb(Arg(0));
+ I++;
+ goto do_fast_element;
+
+ OpCase(i_fast_element_yjId):
+ fast_element_tuple = yb(Arg(0));
+ I++;
+ goto do_fast_element;
}
OpCase(catch_yf):
@@ -1842,8 +1991,87 @@ void process_main(void)
NextPF(0, next);
}
- OpCase(i_select_val_sfI):
- GetArg1(0, tmp_arg1);
+
+ {
+ Eterm select_val2;
+
+ OpCase(i_select_tuple_arity2_yfAfAf):
+ select_val2 = yb(Arg(0));
+ goto do_select_tuple_arity2;
+
+ OpCase(i_select_tuple_arity2_xfAfAf):
+ select_val2 = xb(Arg(0));
+ goto do_select_tuple_arity2;
+
+ OpCase(i_select_tuple_arity2_rfAfAf):
+ select_val2 = r(0);
+ I--;
+
+ do_select_tuple_arity2:
+ if (is_not_tuple(select_val2)) {
+ goto select_val2_fail;
+ }
+ select_val2 = *tuple_val(select_val2);
+ goto do_select_val2;
+
+ OpCase(i_select_val2_yfcfcf):
+ select_val2 = yb(Arg(0));
+ goto do_select_val2;
+
+ OpCase(i_select_val2_xfcfcf):
+ select_val2 = xb(Arg(0));
+ goto do_select_val2;
+
+ OpCase(i_select_val2_rfcfcf):
+ select_val2 = r(0);
+ I--;
+
+ do_select_val2:
+ if (select_val2 == Arg(2)) {
+ I += 2;
+ } else if (select_val2 == Arg(4)) {
+ I += 4;
+ }
+
+ select_val2_fail:
+ SET_I((BeamInstr *) Arg(1));
+ Goto(*I);
+ }
+
+ {
+ Eterm select_val;
+
+ OpCase(i_select_tuple_arity_xfI):
+ select_val = xb(Arg(0));
+ goto do_select_tuple_arity;
+
+ OpCase(i_select_tuple_arity_yfI):
+ select_val = yb(Arg(0));
+ goto do_select_tuple_arity;
+
+ OpCase(i_select_tuple_arity_rfI):
+ select_val = r(0);
+ I--;
+
+ do_select_tuple_arity:
+ if (is_tuple(select_val)) {
+ select_val = *tuple_val(select_val);
+ goto do_binary_search;
+ }
+ SET_I((BeamInstr *) Arg(1));
+ Goto(*I);
+
+ OpCase(i_select_val_xfI):
+ select_val = xb(Arg(0));
+ goto do_binary_search;
+
+ OpCase(i_select_val_yfI):
+ select_val = yb(Arg(0));
+ goto do_binary_search;
+
+ OpCase(i_select_val_rfI):
+ select_val = r(0);
+ I--;
do_binary_search:
{
@@ -1880,9 +2108,9 @@ void process_main(void)
unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1);
mid = (struct Pairs*)((char*)low + boffset);
- if (tmp_arg1 < mid->val) {
+ if (select_val < mid->val) {
high = mid;
- } else if (tmp_arg1 > mid->val) {
+ } else if (select_val > mid->val) {
low = mid + 1;
} else {
SET_I(mid->addr);
@@ -1892,16 +2120,28 @@ void process_main(void)
SET_I((BeamInstr *) Arg(1));
Goto(*I);
}
+ }
- OpCase(i_jump_on_val_zero_sfI):
{
- Eterm index;
-
- GetArg1(0, index);
- if (is_small(index)) {
- index = signed_val(index);
- if (index < Arg(2)) {
- SET_I((BeamInstr *) (&Arg(3))[index]);
+ Eterm jump_on_val_zero_index;
+
+ OpCase(i_jump_on_val_zero_yfI):
+ jump_on_val_zero_index = yb(Arg(0));
+ goto do_jump_on_val_zero_index;
+
+ OpCase(i_jump_on_val_zero_xfI):
+ jump_on_val_zero_index = xb(Arg(0));
+ goto do_jump_on_val_zero_index;
+
+ OpCase(i_jump_on_val_zero_rfI):
+ jump_on_val_zero_index = r(0);
+ I--;
+
+ do_jump_on_val_zero_index:
+ if (is_small(jump_on_val_zero_index)) {
+ jump_on_val_zero_index = signed_val(jump_on_val_zero_index);
+ if (jump_on_val_zero_index < Arg(2)) {
+ SET_I((BeamInstr *) (&Arg(3))[jump_on_val_zero_index]);
Goto(*I);
}
}
@@ -1909,15 +2149,27 @@ void process_main(void)
Goto(*I);
}
- OpCase(i_jump_on_val_sfII):
{
- Eterm index;
+ Eterm jump_on_val_index;
- GetArg1(0, index);
- if (is_small(index)) {
- index = (Uint) (signed_val(index) - Arg(3));
- if (index < Arg(2)) {
- SET_I((BeamInstr *) (&Arg(4))[index]);
+
+ OpCase(i_jump_on_val_yfII):
+ jump_on_val_index = yb(Arg(0));
+ goto do_jump_on_val_index;
+
+ OpCase(i_jump_on_val_xfII):
+ jump_on_val_index = xb(Arg(0));
+ goto do_jump_on_val_index;
+
+ OpCase(i_jump_on_val_rfII):
+ jump_on_val_index = r(0);
+ I--;
+
+ do_jump_on_val_index:
+ if (is_small(jump_on_val_index)) {
+ jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3));
+ if (jump_on_val_index < Arg(2)) {
+ SET_I((BeamInstr *) (&Arg(4))[jump_on_val_index]);
Goto(*I);
}
}
@@ -1925,6 +2177,32 @@ void process_main(void)
Goto(*I);
}
+ do_put_tuple: {
+ Eterm* hp = HTOP;
+
+ *hp++ = make_arityval(pt_arity);
+
+ do {
+ Eterm term = *I++;
+ switch (term & _TAG_IMMED1_MASK) {
+ case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
+ *hp++ = r(0);
+ break;
+ case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
+ *hp++ = x(term >> _TAG_IMMED1_SIZE);
+ break;
+ case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
+ *hp++ = y(term >> _TAG_IMMED1_SIZE);
+ break;
+ default:
+ *hp++ = term;
+ break;
+ }
+ } while (--pt_arity != 0);
+ HTOP = hp;
+ Goto(*I);
+ }
+
/*
* All guards with zero arguments have special instructions:
* self/0
@@ -2562,23 +2840,25 @@ void process_main(void)
OpCase(i_int_bnot_jsId):
{
- GetArg1(1, tmp_arg1);
- if (is_small(tmp_arg1)) {
- tmp_arg1 = make_small(~signed_val(tmp_arg1));
+ Eterm bnot_val;
+
+ GetArg1(1, bnot_val);
+ if (is_small(bnot_val)) {
+ bnot_val = make_small(~signed_val(bnot_val));
} else {
Uint live = Arg(2);
SWAPOUT;
reg[0] = r(0);
- reg[live] = tmp_arg1;
- tmp_arg1 = erts_gc_bnot(c_p, reg, live);
+ reg[live] = bnot_val;
+ bnot_val = erts_gc_bnot(c_p, reg, live);
r(0) = reg[0];
SWAPIN;
ERTS_HOLE_CHECK(c_p);
- if (is_nil(tmp_arg1)) {
+ if (is_nil(bnot_val)) {
goto lb_Cl_error;
}
}
- StoreBifResult(3, tmp_arg1);
+ StoreBifResult(3, bnot_val);
}
badarith:
@@ -2833,121 +3113,6 @@ void process_main(void)
goto do_schedule1;
}
- OpCase(i_select_tuple_arity_sfI):
- {
- GetArg1(0, tmp_arg1);
-
- if (is_tuple(tmp_arg1)) {
- tmp_arg1 = *tuple_val(tmp_arg1);
- goto do_binary_search;
- }
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-
- OpCase(i_select_big_sf):
- {
- Eterm* bigp;
- Uint arity;
- Eterm* given;
- Uint given_arity;
- Uint given_size;
-
- GetArg1(0, tmp_arg1);
- if (is_big(tmp_arg1)) {
-
- /*
- * The loader has sorted the bignumbers in descending order
- * on the arity word. Therefore, we know that the search
- * has failed as soon as we encounter an arity word less than
- * the arity word of the given number. There is a zero word
- * (less than any valid arity word) stored after the last bignumber.
- */
-
- given = big_val(tmp_arg1);
- given_arity = given[0];
- given_size = thing_arityval(given_arity);
- bigp = (Eterm *) &Arg(2);
- while ((arity = bigp[0]) > given_arity) {
- bigp += (TermWords(thing_arityval(arity) + 1) + 1) * (sizeof(BeamInstr)/sizeof(Eterm));
- }
- while (bigp[0] == given_arity) {
- if (memcmp(bigp+1, given+1, sizeof(Eterm)*given_size) == 0) {
- BeamInstr *tmp =
- ((BeamInstr *) (UWord) bigp) + TermWords(given_size + 1);
- SET_I((BeamInstr *) *tmp);
- Goto(*I);
- }
- bigp += (TermWords(thing_arityval(arity) + 1) + 1) * (sizeof(BeamInstr)/sizeof(Eterm));
- }
- }
-
- /*
- * Failed.
- */
-
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-
-#if defined(ARCH_64) && !HALFWORD_HEAP
- OpCase(i_select_float_sfI):
- {
- Uint f;
- int n;
- struct ValLabel {
- Uint f;
- BeamInstr* addr;
- };
- struct ValLabel* ptr;
-
- GetArg1(0, tmp_arg1);
- ASSERT(is_float(tmp_arg1));
- f = float_val(tmp_arg1)[1];
- n = Arg(2);
- ptr = (struct ValLabel *) &Arg(3);
- while (n-- > 0) {
- if (ptr->f == f) {
- SET_I(ptr->addr);
- Goto(*I);
- }
- ptr++;
- }
- SET_I((Eterm *) Arg(1));
- Goto(*I);
- }
-#else
- OpCase(i_select_float_sfI):
- {
- Uint fpart1;
- Uint fpart2;
- int n;
- struct ValLabel {
- Uint fpart1;
- Uint fpart2;
- BeamInstr* addr;
- };
- struct ValLabel* ptr;
-
- GetArg1(0, tmp_arg1);
- ASSERT(is_float(tmp_arg1));
- fpart1 = float_val(tmp_arg1)[1];
- fpart2 = float_val(tmp_arg1)[2];
-
- n = Arg(2);
- ptr = (struct ValLabel *) &Arg(3);
- while (n-- > 0) {
- if (ptr->fpart1 == fpart1 && ptr->fpart2 == fpart2) {
- SET_I(ptr->addr);
- Goto(*I);
- }
- ptr++;
- }
- SET_I((BeamInstr *) Arg(1));
- Goto(*I);
- }
-#endif
-
OpCase(set_tuple_element_sdP): {
Eterm element;
Eterm tuple;
@@ -2993,15 +3158,17 @@ void process_main(void)
the first argument. We also handle atom tags in the first
argument for backwards compatibility.
*/
- GetArg2(0, tmp_arg1, tmp_arg2);
- c_p->fvalue = tmp_arg2;
+ Eterm raise_val1;
+ Eterm raise_val2;
+ GetArg2(0, raise_val1, raise_val2);
+ c_p->fvalue = raise_val2;
if (c_p->freason == EXC_NULL) {
/* a safety check for the R10-0 case; should not happen */
c_p->ftrace = NIL;
c_p->freason = EXC_ERROR;
}
/* for R10-0 code, keep existing c_p->ftrace and hope it's correct */
- switch (tmp_arg1) {
+ switch (raise_val1) {
case am_throw:
c_p->freason = EXC_THROWN & ~EXF_SAVETRACE;
break;
@@ -3017,8 +3184,8 @@ void process_main(void)
passed from a user! Currently only expecting generated calls.
*/
struct StackTrace *s;
- c_p->ftrace = tmp_arg1;
- s = get_trace_from_exc(tmp_arg1);
+ c_p->ftrace = raise_val1;
+ s = get_trace_from_exc(raise_val1);
if (s == NULL) {
c_p->freason = EXC_ERROR;
} else {
@@ -3029,11 +3196,24 @@ void process_main(void)
goto find_func_info;
}
- OpCase(badmatch_s): {
- GetArg1(0, tmp_arg1);
- c_p->fvalue = tmp_arg1;
- c_p->freason = BADMATCH;
- }
+ {
+ Eterm badmatch_val;
+
+ OpCase(badmatch_y):
+ badmatch_val = yb(Arg(0));
+ goto do_badmatch;
+
+ OpCase(badmatch_x):
+ badmatch_val = xb(Arg(0));
+ goto do_badmatch;
+
+ OpCase(badmatch_r):
+ badmatch_val = r(0);
+
+ do_badmatch:
+ c_p->fvalue = badmatch_val;
+ c_p->freason = BADMATCH;
+ }
/* Fall through here */
find_func_info: {
@@ -3056,12 +3236,11 @@ void process_main(void)
*/
SWAPOUT;
reg[0] = r(0);
- tmp_arg1 = call_error_handler(c_p, I-3, reg);
+ I = call_error_handler(c_p, I-3, reg, am_undefined_function);
r(0) = reg[0];
SWAPIN;
- if (tmp_arg1) {
- SET_I(c_p->i);
- Dispatch();
+ if (I) {
+ Goto(*I);
}
/* Fall through */
@@ -3084,128 +3263,142 @@ void process_main(void)
}
}
- OpCase(call_nif):
- {
- /*
- * call_nif is always first instruction in function:
- *
- * I[-3]: Module
- * I[-2]: Function
- * I[-1]: Arity
- * I[0]: &&call_nif
- * I[1]: Function pointer to NIF function
- * I[2]: Pointer to erl_module_nif
- */
- BifFunction vbf;
-
- c_p->current = I-3; /* current and vbf set to please handle_error */
- SWAPOUT;
- c_p->fcalls = FCALLS - 1;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- tmp_arg2 = I[-1];
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ {
+ Eterm nif_bif_result;
+ Eterm bif_nif_arity;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- {
- typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]);
- NifF* fp = vbf = (NifF*) I[1];
- struct enif_environment_t env;
- erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]);
- reg[0] = r(0);
- tmp_arg1 = (*fp)(&env, tmp_arg2, reg);
- erts_post_nif(&env);
- }
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
- PROCESS_MAIN_CHK_LOCKS(c_p);
- goto apply_bif_or_nif_epilogue;
-
- OpCase(apply_bif):
- /*
- * At this point, I points to the code[3] in the export entry for
- * the BIF:
- *
- * code[0]: Module
- * code[1]: Function
- * code[2]: Arity
- * code[3]: &&apply_bif
- * code[4]: Function pointer to BIF function
- */
+ OpCase(call_nif):
+ {
+ /*
+ * call_nif is always first instruction in function:
+ *
+ * I[-3]: Module
+ * I[-2]: Function
+ * I[-1]: Arity
+ * I[0]: &&call_nif
+ * I[1]: Function pointer to NIF function
+ * I[2]: Pointer to erl_module_nif
+ */
+ BifFunction vbf;
- c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */
- c_p->i = I; /* In case we apply check_process_code/2. */
- c_p->arity = 0; /* To allow garbage collection on ourselves
- * (check_process_code/2).
- */
- SWAPOUT;
- c_p->fcalls = FCALLS - 1;
- vbf = (BifFunction) Arg(0);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- tmp_arg2 = I[-1];
- ASSERT(tmp_arg2 <= 3);
- ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- switch (tmp_arg2) {
- case 3:
+ c_p->current = I-3; /* current and vbf set to please handle_error */
+ SWAPOUT;
+ c_p->fcalls = FCALLS - 1;
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ bif_nif_arity = I[-1];
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
{
- Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- tmp_arg1 = (*bf)(c_p, r(0), x(1), x(2), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
- PROCESS_MAIN_CHK_LOCKS(c_p);
+ typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]);
+ NifF* fp = vbf = (NifF*) I[1];
+ struct enif_environment_t env;
+ erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]);
+ reg[0] = r(0);
+ nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
+ erts_post_nif(&env);
}
- break;
- case 2:
- {
- Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- tmp_arg1 = (*bf)(c_p, r(0), x(1), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
- PROCESS_MAIN_CHK_LOCKS(c_p);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result));
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ goto apply_bif_or_nif_epilogue;
+
+ OpCase(apply_bif):
+ /*
+ * At this point, I points to the code[3] in the export entry for
+ * the BIF:
+ *
+ * code[0]: Module
+ * code[1]: Function
+ * code[2]: Arity
+ * code[3]: &&apply_bif
+ * code[4]: Function pointer to BIF function
+ */
+
+ c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */
+ c_p->i = I; /* In case we apply check_process_code/2. */
+ c_p->arity = 0; /* To allow garbage collection on ourselves
+ * (check_process_code/2).
+ */
+ SWAPOUT;
+ c_p->fcalls = FCALLS - 1;
+ vbf = (BifFunction) Arg(0);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ bif_nif_arity = I[-1];
+ ASSERT(bif_nif_arity <= 3);
+ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ switch (bif_nif_arity) {
+ case 3:
+ {
+ Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ }
+ break;
+ case 2:
+ {
+ Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ nif_bif_result = (*bf)(c_p, r(0), x(1), I);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ }
+ break;
+ case 1:
+ {
+ Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ nif_bif_result = (*bf)(c_p, r(0), I);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ }
+ break;
+ case 0:
+ {
+ Eterm (*bf)(Process*, BeamInstr*) = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ nif_bif_result = (*bf)(c_p, I);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ break;
+ }
+ default:
+ erl_exit(1, "apply_bif: invalid arity: %u\n",
+ bif_nif_arity);
}
- break;
- case 1:
- {
- Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- tmp_arg1 = (*bf)(c_p, r(0), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
- PROCESS_MAIN_CHK_LOCKS(c_p);
+
+ apply_bif_or_nif_epilogue:
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ ERTS_HOLE_CHECK(c_p);
+ if (c_p->mbuf) {
+ reg[0] = r(0);
+ nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result,
+ reg, bif_nif_arity);
+ r(0) = reg[0];
}
- break;
- case 0:
- {
- Eterm (*bf)(Process*, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- tmp_arg1 = (*bf)(c_p, I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1));
- PROCESS_MAIN_CHK_LOCKS(c_p);
- break;
+ SWAPIN; /* There might have been a garbage collection. */
+ FCALLS = c_p->fcalls;
+ if (is_value(nif_bif_result)) {
+ r(0) = nif_bif_result;
+ CHECK_TERM(r(0));
+ SET_I(c_p->cp);
+ Goto(*I);
+ } else if (c_p->freason == TRAP) {
+ SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3)));
+ r(0) = c_p->def_arg_reg[0];
+ x(1) = c_p->def_arg_reg[1];
+ x(2) = c_p->def_arg_reg[2];
+ Dispatch();
}
- }
-apply_bif_or_nif_epilogue:
- ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- ERTS_HOLE_CHECK(c_p);
- if (c_p->mbuf) {
reg[0] = r(0);
- tmp_arg1 = erts_gc_after_bif_call(c_p, tmp_arg1, reg, tmp_arg2);
- r(0) = reg[0];
- }
- SWAPIN; /* There might have been a garbage collection. */
- FCALLS = c_p->fcalls;
- if (is_value(tmp_arg1)) {
- r(0) = tmp_arg1;
- CHECK_TERM(r(0));
- SET_I(c_p->cp);
- Goto(*I);
- } else if (c_p->freason == TRAP) {
- SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3)));
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
- x(2) = c_p->def_arg_reg[2];
- Dispatch();
+ I = handle_error(c_p, c_p->cp, reg, vbf);
+ goto post_error_handling;
}
- reg[0] = r(0);
- I = handle_error(c_p, c_p->cp, reg, vbf);
- goto post_error_handling;
}
OpCase(i_get_sd):
@@ -3218,11 +3411,26 @@ apply_bif_or_nif_epilogue:
StoreBifResult(1, result);
}
- OpCase(case_end_s):
- GetArg1(0, tmp_arg1);
- c_p->fvalue = tmp_arg1;
- c_p->freason = EXC_CASE_CLAUSE;
- goto find_func_info;
+ {
+ Eterm case_end_val;
+
+ OpCase(case_end_x):
+ case_end_val = xb(Arg(0));
+ goto do_case_end;
+
+ OpCase(case_end_y):
+ case_end_val = yb(Arg(0));
+ goto do_case_end;
+
+ OpCase(case_end_r):
+ case_end_val = r(0);
+ I--;
+
+ do_case_end:
+ c_p->fvalue = case_end_val;
+ c_p->freason = EXC_CASE_CLAUSE;
+ goto find_func_info;
+ }
OpCase(if_end):
c_p->freason = EXC_IF_CLAUSE;
@@ -3235,10 +3443,13 @@ apply_bif_or_nif_epilogue:
}
OpCase(try_case_end_s):
- GetArg1(0, tmp_arg1);
- c_p->fvalue = tmp_arg1;
- c_p->freason = EXC_TRY_CLAUSE;
- goto find_func_info;
+ {
+ Eterm try_case_end_val;
+ GetArg1(0, try_case_end_val);
+ c_p->fvalue = try_case_end_val;
+ c_p->freason = EXC_TRY_CLAUSE;
+ goto find_func_info;
+ }
/*
* Construction of binaries using new instructions.
@@ -3786,19 +3997,20 @@ apply_bif_or_nif_epilogue:
Eterm header;
BeamInstr *next;
Uint slots;
+ Eterm context;
OpCase(i_bs_start_match2_rfIId): {
- tmp_arg1 = r(0);
+ context = r(0);
do_start_match:
slots = Arg(2);
- if (!is_boxed(tmp_arg1)) {
+ if (!is_boxed(context)) {
ClauseFail();
}
PreFetch(4, next);
- header = *boxed_val(tmp_arg1);
+ header = *boxed_val(context);
if (header_is_bin_matchstate(header)) {
- ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(tmp_arg1);
+ ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context);
Uint actual_slots = HEADER_NUM_SLOTS(header);
ms->save_offset[0] = ms->mb.offset;
if (actual_slots < slots) {
@@ -3806,8 +4018,8 @@ apply_bif_or_nif_epilogue:
Uint live = Arg(1);
Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots);
- TestHeapPreserve(wordsneeded, live, tmp_arg1);
- ms = (ErlBinMatchState *) boxed_val(tmp_arg1);
+ TestHeapPreserve(wordsneeded, live, context);
+ ms = (ErlBinMatchState *) boxed_val(context);
dst = (ErlBinMatchState *) HTOP;
*dst = *ms;
*HTOP = HEADER_BIN_MATCHSTATE(slots);
@@ -3819,12 +4031,12 @@ apply_bif_or_nif_epilogue:
Eterm result;
Uint live = Arg(1);
Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots);
- TestHeapPreserve(wordsneeded, live, tmp_arg1);
+ TestHeapPreserve(wordsneeded, live, context);
HEAP_TOP(c_p) = HTOP;
#ifdef DEBUG
c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */
#endif
- result = erts_bs_start_match_2(c_p, tmp_arg1, slots);
+ result = erts_bs_start_match_2(c_p, context, slots);
HTOP = HEAP_TOP(c_p);
HEAP_SPACE_VERIFIED(0);
if (is_non_value(result)) {
@@ -3838,12 +4050,12 @@ apply_bif_or_nif_epilogue:
NextPF(4, next);
}
OpCase(i_bs_start_match2_xfIId): {
- tmp_arg1 = xb(Arg(0));
+ context = xb(Arg(0));
I++;
goto do_start_match;
}
OpCase(i_bs_start_match2_yfIId): {
- tmp_arg1 = yb(Arg(0));
+ context = yb(Arg(0));
I++;
goto do_start_match;
}
@@ -3936,93 +4148,105 @@ apply_bif_or_nif_epilogue:
NextPF(2, next);
}
+ {
+ Eterm bs_get_integer8_context;
+
OpCase(i_bs_get_integer_8_rfd): {
- tmp_arg1 = r(0);
- goto do_bs_get_integer_8;
- }
+ bs_get_integer8_context = r(0);
+ goto do_bs_get_integer_8;
+ }
OpCase(i_bs_get_integer_8_xfd): {
- tmp_arg1 = xb(Arg(0));
- I++;
- }
+ bs_get_integer8_context = xb(Arg(0));
+ I++;
+ }
do_bs_get_integer_8: {
- ErlBinMatchBuffer *_mb;
- Eterm _result;
- _mb = ms_matchbuffer(tmp_arg1);
- if (_mb->size - _mb->offset < 8) {
- ClauseFail();
- }
- if (BIT_OFFSET(_mb->offset) != 0) {
- _result = erts_bs_get_integer_2(c_p, 8, 0, _mb);
- } else {
- _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]);
- _mb->offset += 8;
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ _mb = ms_matchbuffer(bs_get_integer8_context);
+ if (_mb->size - _mb->offset < 8) {
+ ClauseFail();
+ }
+ if (BIT_OFFSET(_mb->offset) != 0) {
+ _result = erts_bs_get_integer_2(c_p, 8, 0, _mb);
+ } else {
+ _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]);
+ _mb->offset += 8;
+ }
+ StoreBifResult(1, _result);
}
- StoreBifResult(1, _result);
}
- OpCase(i_bs_get_integer_16_rfd): {
- tmp_arg1 = r(0);
+ {
+ Eterm bs_get_integer_16_context;
+
+ OpCase(i_bs_get_integer_16_rfd):
+ bs_get_integer_16_context = r(0);
goto do_bs_get_integer_16;
- }
- OpCase(i_bs_get_integer_16_xfd): {
- tmp_arg1 = xb(Arg(0));
+ OpCase(i_bs_get_integer_16_xfd):
+ bs_get_integer_16_context = xb(Arg(0));
I++;
- }
- do_bs_get_integer_16: {
- ErlBinMatchBuffer *_mb;
- Eterm _result;
- _mb = ms_matchbuffer(tmp_arg1);
- if (_mb->size - _mb->offset < 16) {
- ClauseFail();
- }
- if (BIT_OFFSET(_mb->offset) != 0) {
- _result = erts_bs_get_integer_2(c_p, 16, 0, _mb);
- } else {
- _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset)));
- _mb->offset += 16;
+ do_bs_get_integer_16:
+ {
+ ErlBinMatchBuffer *_mb;
+ Eterm _result;
+ _mb = ms_matchbuffer(bs_get_integer_16_context);
+ if (_mb->size - _mb->offset < 16) {
+ ClauseFail();
+ }
+ if (BIT_OFFSET(_mb->offset) != 0) {
+ _result = erts_bs_get_integer_2(c_p, 16, 0, _mb);
+ } else {
+ _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset)));
+ _mb->offset += 16;
+ }
+ StoreBifResult(1, _result);
}
- StoreBifResult(1, _result);
}
- OpCase(i_bs_get_integer_32_rfId): {
- tmp_arg1 = r(0);
+ {
+ Eterm bs_get_integer_32_context;
+
+ OpCase(i_bs_get_integer_32_rfId):
+ bs_get_integer_32_context = r(0);
goto do_bs_get_integer_32;
- }
+
- OpCase(i_bs_get_integer_32_xfId): {
- tmp_arg1 = xb(Arg(0));
+ OpCase(i_bs_get_integer_32_xfId):
+ bs_get_integer_32_context = xb(Arg(0));
I++;
- }
- do_bs_get_integer_32: {
- ErlBinMatchBuffer *_mb;
- Uint32 _integer;
- Eterm _result;
- _mb = ms_matchbuffer(tmp_arg1);
- if (_mb->size - _mb->offset < 32) { ClauseFail(); }
- if (BIT_OFFSET(_mb->offset) != 0) {
- _integer = erts_bs_get_unaligned_uint32(_mb);
- } else {
- _integer = get_int32(_mb->base + _mb->offset/8);
- }
- _mb->offset += 32;
+
+ do_bs_get_integer_32:
+ {
+ ErlBinMatchBuffer *_mb;
+ Uint32 _integer;
+ Eterm _result;
+ _mb = ms_matchbuffer(bs_get_integer_32_context);
+ if (_mb->size - _mb->offset < 32) { ClauseFail(); }
+ if (BIT_OFFSET(_mb->offset) != 0) {
+ _integer = erts_bs_get_unaligned_uint32(_mb);
+ } else {
+ _integer = get_int32(_mb->base + _mb->offset/8);
+ }
+ _mb->offset += 32;
#if !defined(ARCH_64) || HALFWORD_HEAP
- if (IS_USMALL(0, _integer)) {
+ if (IS_USMALL(0, _integer)) {
#endif
- _result = make_small(_integer);
+ _result = make_small(_integer);
#if !defined(ARCH_64) || HALFWORD_HEAP
- } else {
- TestHeap(BIG_UINT_HEAP_SIZE, Arg(1));
- _result = uint_to_big((Uint) _integer, HTOP);
- HTOP += BIG_UINT_HEAP_SIZE;
- HEAP_SPACE_VERIFIED(0);
- }
+ } else {
+ TestHeap(BIG_UINT_HEAP_SIZE, Arg(1));
+ _result = uint_to_big((Uint) _integer, HTOP);
+ HTOP += BIG_UINT_HEAP_SIZE;
+ HEAP_SPACE_VERIFIED(0);
+ }
#endif
- StoreBifResult(2, _result);
+ StoreBifResult(2, _result);
+ }
}
/* Operands: Size Live Fail Flags Dst */
@@ -4120,54 +4344,64 @@ apply_bif_or_nif_epilogue:
StoreBifResult(3, result);
}
- /* Operands: MatchContext Fail Dst */
+ {
+ Eterm get_utf8_context;
+
+ /* Operands: MatchContext Fail Dst */
OpCase(i_bs_get_utf8_rfd): {
- tmp_arg1 = r(0);
- goto do_bs_get_utf8;
- }
+ get_utf8_context = r(0);
+ goto do_bs_get_utf8;
+ }
OpCase(i_bs_get_utf8_xfd): {
- tmp_arg1 = xb(Arg(0));
- I++;
- }
+ get_utf8_context = xb(Arg(0));
+ I++;
+ }
- /*
- * tmp_arg1 = match_context
- * Operands: Fail Dst
- */
+ /*
+ * get_utf8_context = match_context
+ * Operands: Fail Dst
+ */
- do_bs_get_utf8: {
- Eterm result = erts_bs_get_utf8(ms_matchbuffer(tmp_arg1));
- if (is_non_value(result)) {
- ClauseFail();
+ do_bs_get_utf8: {
+ Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context));
+ if (is_non_value(result)) {
+ ClauseFail();
+ }
+ StoreBifResult(1, result);
}
- StoreBifResult(1, result);
}
- /* Operands: MatchContext Fail Flags Dst */
+ {
+ Eterm get_utf16_context;
+
+ /* Operands: MatchContext Fail Flags Dst */
OpCase(i_bs_get_utf16_rfId): {
- tmp_arg1 = r(0);
- goto do_bs_get_utf16;
- }
+ get_utf16_context = r(0);
+ goto do_bs_get_utf16;
+ }
OpCase(i_bs_get_utf16_xfId): {
- tmp_arg1 = xb(Arg(0));
- I++;
- }
+ get_utf16_context = xb(Arg(0));
+ I++;
+ }
- /*
- * tmp_arg1 = match_context
- * Operands: Fail Flags Dst
- */
- do_bs_get_utf16: {
- Eterm result = erts_bs_get_utf16(ms_matchbuffer(tmp_arg1), Arg(1));
- if (is_non_value(result)) {
- ClauseFail();
+ /*
+ * get_utf16_context = match_context
+ * Operands: Fail Flags Dst
+ */
+ do_bs_get_utf16: {
+ Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context),
+ Arg(1));
+ if (is_non_value(result)) {
+ ClauseFail();
+ }
+ StoreBifResult(2, result);
}
- StoreBifResult(2, result);
}
{
+ Eterm context_to_binary_context;
ErlBinMatchBuffer* mb;
ErlSubBin* sb;
Uint size;
@@ -4176,27 +4410,29 @@ apply_bif_or_nif_epilogue:
Uint hole_size;
OpCase(bs_context_to_binary_r): {
- tmp_arg1 = x0;
+ context_to_binary_context = x0;
I -= 2;
goto do_context_to_binary;
}
/* Unfortunately, inlining can generate this instruction. */
OpCase(bs_context_to_binary_y): {
- tmp_arg1 = yb(Arg(0));
+ context_to_binary_context = yb(Arg(0));
goto do_context_to_binary0;
}
OpCase(bs_context_to_binary_x): {
- tmp_arg1 = xb(Arg(0));
+ context_to_binary_context = xb(Arg(0));
do_context_to_binary0:
I--;
}
do_context_to_binary:
- if (is_boxed(tmp_arg1) && header_is_bin_matchstate(*boxed_val(tmp_arg1))) {
- ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(tmp_arg1);
+ if (is_boxed(context_to_binary_context) &&
+ header_is_bin_matchstate(*boxed_val(context_to_binary_context))) {
+ ErlBinMatchState* ms;
+ ms = (ErlBinMatchState *) boxed_val(context_to_binary_context);
mb = &ms->mb;
offs = ms->save_offset[0];
size = mb->size - offs;
@@ -4205,17 +4441,17 @@ apply_bif_or_nif_epilogue:
Next(2);
OpCase(i_bs_get_binary_all_reuse_rfI): {
- tmp_arg1 = x0;
+ context_to_binary_context = x0;
goto do_bs_get_binary_all_reuse;
}
OpCase(i_bs_get_binary_all_reuse_xfI): {
- tmp_arg1 = xb(Arg(0));
+ context_to_binary_context = xb(Arg(0));
I++;
}
do_bs_get_binary_all_reuse:
- mb = ms_matchbuffer(tmp_arg1);
+ mb = ms_matchbuffer(context_to_binary_context);
size = mb->size - mb->offset;
if (size % Arg(1) != 0) {
ClauseFail();
@@ -4224,7 +4460,7 @@ apply_bif_or_nif_epilogue:
do_bs_get_binary_all_reuse_common:
orig = mb->orig;
- sb = (ErlSubBin *) boxed_val(tmp_arg1);
+ sb = (ErlSubBin *) boxed_val(context_to_binary_context);
hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE;
sb->thing_word = HEADER_SUB_BIN;
sb->size = BYTE_OFFSET(size);
@@ -4240,12 +4476,14 @@ apply_bif_or_nif_epilogue:
}
{
+ Eterm match_string_context;
+
OpCase(i_bs_match_string_rfII): {
- tmp_arg1 = r(0);
+ match_string_context = r(0);
goto do_bs_match_string;
}
OpCase(i_bs_match_string_xfII): {
- tmp_arg1 = xb(Arg(0));
+ match_string_context = xb(Arg(0));
I++;
}
@@ -4260,7 +4498,7 @@ apply_bif_or_nif_epilogue:
PreFetch(3, next);
bits = Arg(1);
bytes = (byte *) Arg(2);
- mb = ms_matchbuffer(tmp_arg1);
+ mb = ms_matchbuffer(match_string_context);
if (mb->size - mb->offset < bits) {
ClauseFail();
}
@@ -4723,7 +4961,7 @@ apply_bif_or_nif_epilogue:
NextPF(2, next);
}
- OpCase(fmove_new_ld): {
+ OpCase(fmove_ld): {
Eterm fr = Arg(0);
Eterm dest = make_float(HTOP);
@@ -4753,11 +4991,6 @@ apply_bif_or_nif_epilogue:
NextPF(2, next);
}
- /*
- * Old allocating fmove.
- */
-
-
#ifdef NO_FPE_SIGNALS
OpCase(fclearerror):
OpCase(i_fcheckerror):
@@ -4969,12 +5202,11 @@ apply_bif_or_nif_epilogue:
OpCase(i_debug_breakpoint): {
SWAPOUT;
reg[0] = r(0);
- tmp_arg1 = call_breakpoint_handler(c_p, I-3, reg);
+ I = call_error_handler(c_p, I-3, reg, am_breakpoint);
r(0) = reg[0];
SWAPIN;
- if (tmp_arg1) {
- SET_I(c_p->i);
- Dispatch();
+ if (I) {
+ Goto(*I);
}
goto no_error_handler;
}
@@ -5724,8 +5956,8 @@ build_stacktrace(Process* c_p, Eterm exc) {
}
-static Eterm
-call_error_handler(Process* p, BeamInstr* fi, Eterm* reg)
+static BeamInstr*
+call_error_handler(Process* p, BeamInstr* fi, Eterm* reg, Eterm func)
{
Eterm* hp;
Export* ep;
@@ -5737,14 +5969,12 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg)
/*
* Search for the error_handler module.
*/
- ep = erts_find_function(erts_proc_get_error_handler(p),
- am_undefined_function, 3);
+ ep = erts_find_function(erts_proc_get_error_handler(p), func, 3);
if (ep == NULL) { /* No error handler */
p->current = fi;
p->freason = EXC_UNDEF;
return 0;
}
- p->i = ep->address;
/*
* Create a list with all arguments in the x registers.
@@ -5764,63 +5994,14 @@ call_error_handler(Process* p, BeamInstr* fi, Eterm* reg)
}
/*
- * Set up registers for call to error_handler:undefined_function/3.
+ * Set up registers for call to error_handler:<func>/3.
*/
reg[0] = fi[0];
reg[1] = fi[1];
reg[2] = args;
- return 1;
-}
-
-static Eterm
-call_breakpoint_handler(Process* p, BeamInstr* fi, Eterm* reg)
-{
- Eterm* hp;
- Export* ep;
- int arity;
- Eterm args;
- Uint sz;
- int i;
-
- /*
- * Search for error handler module.
- */
- ep = erts_find_function(erts_proc_get_error_handler(p),
- am_breakpoint, 3);
- if (ep == NULL) { /* No error handler */
- p->current = fi;
- p->freason = EXC_UNDEF;
- return 0;
- }
- p->i = ep->address;
-
- /*
- * Create a list with all arguments in the x registers.
- */
-
- arity = fi[2];
- sz = 2 * arity;
- if (HeapWordsLeft(p) < sz) {
- erts_garbage_collect(p, sz, reg, arity);
- }
- hp = HEAP_TOP(p);
- HEAP_TOP(p) += sz;
- args = NIL;
- for (i = arity-1; i >= 0; i--) {
- args = CONS(hp, reg[i], args);
- hp += 2;
- }
-
- /*
- * Set up registers for call to error_handler:breakpoint/3.
- */
- reg[0] = fi[0];
- reg[1] = fi[1];
- reg[2] = args;
- return 1;
+ return ep->address;
}
-
static Export*
apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, Eterm* reg)
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index df5602b040..e6448931eb 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -89,13 +89,12 @@ typedef struct {
} Label;
/*
- * Type for a operand for a generic instruction.
+ * Type for an operand for a generic instruction.
*/
typedef struct {
unsigned type; /* Type of operand. */
- BeamInstr val; /* Value of operand. */
- Uint bigarity; /* Arity for bignumbers (only). */
+ BeamInstr val; /* Value of operand. */
} GenOpArg;
/*
@@ -326,11 +325,6 @@ typedef struct {
Literal* literals; /* Array of literals. */
LiteralPatch* literal_patches; /* Operands that need to be patched. */
Uint total_literal_size; /* Total heap size for all literals. */
-
- /*
- * Floating point.
- */
- int new_float_instructions; /* New allocation scheme for floating point. */
} LoaderState;
typedef struct {
@@ -476,12 +470,14 @@ static int read_code_header(LoaderState* stp);
static int load_code(LoaderState* stp);
static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
GenOpArg Tuple, GenOpArg Dst);
-static GenOp* gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail,
+static GenOp* gen_split_values(LoaderState* stp, GenOpArg S,
+ GenOpArg TypeFail, GenOpArg Fail,
GenOpArg Size, GenOpArg* Rest);
static GenOp* gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
GenOpArg Size, GenOpArg* Rest);
-static GenOp* gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail,
- GenOpArg Size, GenOpArg* Rest);
+static GenOp* gen_select_literals(LoaderState* stp, GenOpArg S,
+ GenOpArg Fail, GenOpArg Size,
+ GenOpArg* Rest);
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,
@@ -818,7 +814,6 @@ init_state(LoaderState* stp)
stp->total_literal_size = 0;
stp->literal_patches = 0;
stp->string_patches = 0;
- stp->new_float_instructions = 0;
stp->may_load_nif = 0;
stp->on_load = 0;
}
@@ -1618,7 +1613,6 @@ load_code(LoaderState* stp)
BeamInstr val;
BeamInstr words = 0;
- stp->new_float_instructions = 1;
GetTagAndValue(stp, tag, n);
VerifyTag(stp, tag, TAG_u);
while (n-- > 0) {
@@ -1772,7 +1766,7 @@ load_code(LoaderState* stp)
}
stp->specific_op = specific;
- CodeNeed(opc[stp->specific_op].sz+2); /* Extra margin for packing */
+ CodeNeed(opc[stp->specific_op].sz+16); /* Extra margin for packing */
code[ci++] = BeamOpCode(stp->specific_op);
}
@@ -1936,7 +1930,8 @@ load_code(LoaderState* stp)
}
code[ci++] = (BeamInstr) stp->import[i].bf;
break;
- case 'P': /* Byte offset into tuple */
+ case 'P': /* Byte offset into tuple or stack */
+ case 'Q': /* Like 'P', but packable */
VerifyTag(stp, tag, TAG_u);
tmp = tmp_op->a[arg].val;
code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm));
@@ -1957,84 +1952,6 @@ load_code(LoaderState* stp)
}
/*
- * Load any list arguments using the primitive tags.
- */
-
- for ( ; arg < tmp_op->arity; arg++) {
- switch (tmp_op->a[arg].type) {
- case TAG_i:
- CodeNeed(1);
- code[ci++] = make_small(tmp_op->a[arg].val);
- break;
- case TAG_u:
- case TAG_a:
- case TAG_v:
- CodeNeed(1);
- code[ci++] = tmp_op->a[arg].val;
- break;
- case TAG_f:
- CodeNeed(1);
- code[ci] = stp->labels[tmp_op->a[arg].val].patches;
- stp->labels[tmp_op->a[arg].val].patches = ci;
- ci++;
- break;
- case TAG_q:
- {
- Eterm lit;
-
- lit = stp->literals[tmp_op->a[arg].val].term;
- if (is_big(lit)) {
- Eterm* bigp;
- Eterm *tmp;
- Uint size;
- Uint term_size;
-
- bigp = big_val(lit);
- term_size = bignum_header_arity(*bigp);
- size = TermWords(term_size + 1);
- CodeNeed(size);
- tmp = (Eterm *) (code + ci);
- *tmp++ = *bigp++;
- while (term_size-- > 0) {
- *tmp++ = *bigp++;
- }
- ci +=size;
- } else if (is_float(lit)) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
- CodeNeed(1);
- code[ci++] = float_val(stp->literals[tmp_op->a[arg].val].term)[1];
-#elif HALFWORD_HEAP
- Eterm* fptr;
- Uint size;
- Eterm *tmp;
-
- fptr = float_val(stp->literals[tmp_op->a[arg].val].term)+1;
- size = TermWords(2);
- CodeNeed(size);
- tmp = (Eterm *) (code + ci);
- *tmp++ = *fptr++;
- *tmp = *fptr;
- ci += size;
-#else
- Eterm* fptr;
-
- fptr = float_val(stp->literals[tmp_op->a[arg].val].term)+1;
- CodeNeed(2);
- code[ci++] = *fptr++;
- code[ci++] = *fptr;
-#endif
- } else {
- LoadError0(stp, "literal is neither float nor big");
- }
- }
- break;
- default:
- LoadError1(stp, "unsupported primitive type '%c'",
- tag_to_letter[tmp_op->a[arg].type]);
- }
- }
-
- /*
* The packing engine.
*/
if (opc[stp->specific_op].pack[0]) {
@@ -2057,6 +1974,11 @@ load_code(LoaderState* stp)
case '6': /* Shift 16 steps */
packed = (packed << BEAM_LOOSE_SHIFT) | code[--ci];
break;
+#ifdef ARCH_64
+ case 'w': /* Shift 32 steps */
+ packed = (packed << BEAM_WIDE_SHIFT) | code[--ci];
+ break;
+#endif
case 'p': /* Put instruction (from stack). */
code[ci++] = *--sp;
break;
@@ -2072,6 +1994,58 @@ load_code(LoaderState* stp)
}
/*
+ * Load any list arguments using the primitive tags.
+ */
+
+ for ( ; arg < tmp_op->arity; arg++) {
+ switch (tmp_op->a[arg].type) {
+ case TAG_i:
+ CodeNeed(1);
+ code[ci++] = make_small(tmp_op->a[arg].val);
+ break;
+ case TAG_u:
+ case TAG_a:
+ case TAG_v:
+ CodeNeed(1);
+ code[ci++] = tmp_op->a[arg].val;
+ break;
+ case TAG_f:
+ CodeNeed(1);
+ code[ci] = stp->labels[tmp_op->a[arg].val].patches;
+ stp->labels[tmp_op->a[arg].val].patches = ci;
+ ci++;
+ break;
+ case TAG_r:
+ CodeNeed(1);
+ code[ci++] = (R_REG_DEF << _TAG_PRIMARY_SIZE) |
+ TAG_PRIMARY_HEADER;
+ break;
+ case TAG_x:
+ CodeNeed(1);
+ code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) |
+ (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_y:
+ CodeNeed(1);
+ code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) |
+ (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_n:
+ CodeNeed(1);
+ code[ci++] = NIL;
+ break;
+ case TAG_q:
+ CodeNeed(1);
+ new_literal_patch(stp, ci);
+ code[ci++] = tmp_op->a[arg].val;
+ break;
+ default:
+ LoadError1(stp, "unsupported primitive type '%c'",
+ tag_to_letter[tmp_op->a[arg].type]);
+ }
+ }
+
+ /*
* Handle a few special cases.
*/
switch (stp->specific_op) {
@@ -2239,11 +2213,12 @@ use_jump_tab(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
}
/*
- * Predicate to test whether all values in a table are big numbers.
+ * Predicate to test whether all values in a table are either
+ * floats or bignums.
*/
static int
-all_values_are_big(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
+floats_or_bignums(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
{
int i;
@@ -2255,9 +2230,6 @@ all_values_are_big(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
if (Rest[i].type != TAG_q) {
return 0;
}
- if (is_not_big(stp->literals[Rest[i].val].term)) {
- return 0;
- }
if (Rest[i+1].type != TAG_f) {
return 0;
}
@@ -2317,6 +2289,14 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest)
return 0;
}
+static int
+same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label)
+{
+ return Target.type = TAG_f && Label.type == TAG_u &&
+ Target.val == Label.val;
+}
+
+
/*
* Generate an instruction for element/2.
*/
@@ -2328,23 +2308,23 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
GenOp* op;
NEW_GENOP(stp, op);
- op->op = genop_i_element_4;
op->arity = 4;
- op->a[0] = Fail;
- op->a[1] = Index;
- op->a[2] = Tuple;
- op->a[3] = Dst;
op->next = NULL;
- /*
- * If safe, generate a faster instruction.
- */
-
if (Index.type == TAG_i && Index.val > 0 &&
(Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) {
op->op = genop_i_fast_element_4;
- op->a[1].type = TAG_u;
- op->a[1].val = Index.val;
+ op->a[0] = Tuple;
+ op->a[1] = Fail;
+ op->a[2].type = TAG_u;
+ op->a[2].val = Index.val;
+ op->a[3] = Dst;
+ } else {
+ op->op = genop_i_element_4;
+ op->a[0] = Tuple;
+ op->a[1] = Fail;
+ op->a[2] = Index;
+ op->a[3] = Dst;
}
return op;
@@ -2595,8 +2575,6 @@ binary_too_big_bits(LoaderState* stp, GenOpArg Size)
return Size.type == TAG_u && (((Size.val+7)/8) >> (8*sizeof(Uint)-3) != 0);
}
-#define new_float_allocation(Stp) ((Stp)->new_float_instructions)
-
static GenOp*
gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size,
GenOpArg Unit, GenOpArg Flags, GenOpArg Src)
@@ -2809,6 +2787,52 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms,
return op;
}
+static GenOp*
+gen_increment(LoaderState* stp, GenOpArg Reg, GenOpArg Integer,
+ GenOpArg Live, GenOpArg Dst)
+{
+ GenOp* op;
+
+ NEW_GENOP(stp, op);
+ op->op = genop_i_increment_4;
+ op->arity = 4;
+ op->next = NULL;
+ op->a[0] = Reg;
+ op->a[1].type = TAG_u;
+ op->a[1].val = Integer.val;
+ op->a[2] = Live;
+ op->a[3] = Dst;
+ return op;
+}
+
+static GenOp*
+gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, GenOpArg Integer,
+ GenOpArg Live, GenOpArg Dst)
+{
+ GenOp* op;
+
+ NEW_GENOP(stp, op);
+ op->op = genop_i_increment_4;
+ op->arity = 4;
+ op->next = NULL;
+ op->a[0] = Reg;
+ op->a[1].type = TAG_u;
+ op->a[1].val = -Integer.val;
+ op->a[2] = Live;
+ op->a[3] = Dst;
+ return op;
+}
+
+/*
+ * Test whether the negation of the given number is small.
+ */
+static int
+negation_is_small(LoaderState* stp, GenOpArg Int)
+{
+ return Int.type == TAG_i && IS_SSMALL(-Int.val);
+}
+
+
static int
smp(LoaderState* stp)
{
@@ -3000,6 +3024,21 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail,
ASSERT(op->a[i].val < op->a[i+2].val);
}
#endif
+
+ /*
+ * Use a special-cased instruction if there are only two values.
+ */
+ if (size == 2) {
+ op->op = genop_i_select_tuple_arity2_6;
+ op->arity--;
+ op->a[2].type = TAG_u;
+ op->a[2].val = arityval(op->a[3].val);
+ op->a[3] = op->a[4];
+ op->a[4].type = TAG_u;
+ op->a[4].val = arityval(op->a[5].val);
+ op->a[5] = op->a[6];
+ }
+
return op;
}
@@ -3009,18 +3048,24 @@ gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail,
*/
static GenOp*
-gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail,
- GenOpArg Size, GenOpArg* Rest)
+gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg TypeFail,
+ GenOpArg Fail, GenOpArg Size, GenOpArg* Rest)
{
GenOp* op1;
GenOp* op2;
GenOp* label;
- Uint type;
+ GenOp* is_integer;
int i;
ASSERT(Size.val >= 2 && Size.val % 2 == 0);
+ NEW_GENOP(stp, is_integer);
+ is_integer->op = genop_is_integer_2;
+ is_integer->arity = 2;
+ is_integer->a[0] = TypeFail;
+ is_integer->a[1] = S;
+
NEW_GENOP(stp, label);
label->op = genop_label_1;
label->arity = 1;
@@ -3046,15 +3091,13 @@ gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail,
op2->a[2].type = TAG_u;
op2->a[2].val = 0;
- op1->next = label;
- label->next = op2;
- op2->next = NULL;
-
- type = Rest[0].type;
+ /*
+ * Split the list.
+ */
ASSERT(Size.type == TAG_u);
for (i = 0; i < Size.val; i += 2) {
- GenOp* op = (Rest[i].type == type) ? op1 : op2;
+ GenOp* op = (Rest[i].type == TAG_q) ? op2 : op1;
int dst = 3 + op->a[2].val;
ASSERT(Rest[i+1].type == TAG_f);
@@ -3063,13 +3106,36 @@ gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail,
op->arity += 2;
op->a[2].val += 2;
}
+ ASSERT(op1->a[2].val > 0);
+ ASSERT(op2->a[2].val > 0);
/*
- * None of the instructions should have zero elements in the list.
+ * Order the instruction sequence appropriately.
*/
- ASSERT(op1->a[2].val > 0);
- ASSERT(op2->a[2].val > 0);
+ if (TypeFail.val == Fail.val) {
+ /*
+ * select_val L1 S ... (small numbers)
+ * label L1
+ * is_integer Fail S
+ * select_val Fail S ... (bignums)
+ */
+ op1->next = label;
+ label->next = is_integer;
+ is_integer->next = op2;
+ } else {
+ /*
+ * is_integer TypeFail S
+ * select_val L1 S ... (small numbers)
+ * label L1
+ * select_val Fail S ... (bignums)
+ */
+ is_integer->next = op1;
+ op1->next = label;
+ label->next = op2;
+ op1 = is_integer;
+ }
+ op2->next = NULL;
return op1;
}
@@ -3091,6 +3157,29 @@ gen_jump_tab(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpAr
ASSERT(Size.val >= 2 && Size.val % 2 == 0);
/*
+ * If there is only one choice, don't generate a jump table.
+ */
+ if (Size.val == 2) {
+ GenOp* jump;
+
+ NEW_GENOP(stp, op);
+ op->arity = 3;
+ op->op = genop_is_ne_exact_3;
+ op->a[0] = Rest[1];
+ op->a[1] = S;
+ op->a[2] = Rest[0];
+
+ NEW_GENOP(stp, jump);
+ jump->next = NULL;
+ jump->arity = 1;
+ jump->op = genop_jump_1;
+ jump->a[0] = Fail;
+
+ op->next = jump;
+ return op;
+ }
+
+ /*
* Calculate the minimum and maximum values and size of jump table.
*/
@@ -3162,8 +3251,9 @@ genopargcompare(GenOpArg* a, GenOpArg* b)
}
/*
- * Generate a select_val instruction. We know that a jump table is not suitable,
- * and that all values are of the same type (integer, atoms, floats; never bignums).
+ * Generate a select_val instruction. We know that a jump table
+ * is not suitable, and that all values are of the same type
+ * (integer or atoms).
*/
static GenOp*
@@ -3177,12 +3267,7 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
NEW_GENOP(stp, op);
op->next = NULL;
- if (Rest[0].type != TAG_q) {
- op->op = genop_i_select_val_3;
- } else {
- ASSERT(is_float(stp->literals[Rest[0].val].term));
- op->op = genop_i_select_float_3;
- }
+ op->op = genop_i_select_val_3;
GENOP_ARITY(op, arity);
op->a[0] = S;
op->a[1] = Fail;
@@ -3204,19 +3289,19 @@ gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
}
#endif
- return op;
-}
-
-/*
- * Compare function for qsort().
- */
+ /*
+ * Use a special-cased instruction if there are only two values.
+ */
+ if (size == 2) {
+ op->op = genop_i_select_val2_6;
+ op->arity--;
+ op->a[2] = op->a[3];
+ op->a[3] = op->a[4];
+ op->a[4] = op->a[5];
+ op->a[5] = op->a[6];
+ }
-static int
-genbigcompare(GenOpArg* a, GenOpArg* b)
-{
- int val = (int)(b->bigarity - a->bigarity);
-
- return val != 0 ? val : ((int) (a->val - b->val));
+ return op;
}
/*
@@ -3224,37 +3309,35 @@ genbigcompare(GenOpArg* a, GenOpArg* b)
*/
static GenOp*
-gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail,
+gen_select_literals(LoaderState* stp, GenOpArg S, GenOpArg Fail,
GenOpArg Size, GenOpArg* Rest)
{
GenOp* op;
- int arity = Size.val + 2 + 1;
- int size = Size.val / 2;
+ GenOp* jump;
+ GenOp** prev_next = &op;
+
int i;
- NEW_GENOP(stp, op);
- op->next = NULL;
- op->op = genop_i_select_big_2;
- GENOP_ARITY(op, arity);
- op->a[0] = S;
- op->a[1] = Fail;
for (i = 0; i < Size.val; i += 2) {
+ GenOp* op;
ASSERT(Rest[i].type == TAG_q);
- op->a[i+2] = Rest[i];
- op->a[i+2].bigarity = *big_val(stp->literals[op->a[i+2].val].term);
- op->a[i+3] = Rest[i+1];
- }
- ASSERT(i+2 == arity-1);
- op->a[arity-1].type = TAG_u;
- op->a[arity-1].val = 0;
-
- /*
- * Sort the values in descending arity order.
- */
-
- qsort(op->a+2, size, 2*sizeof(GenOpArg),
- (int (*)(const void *, const void *)) genbigcompare);
+ NEW_GENOP(stp, op);
+ op->op = genop_is_ne_exact_3;
+ op->arity = 3;
+ op->a[0] = Rest[i+1];
+ op->a[1] = S;
+ op->a[2] = Rest[i];
+ *prev_next = op;
+ prev_next = &op->next;
+ }
+
+ NEW_GENOP(stp, jump);
+ jump->next = NULL;
+ jump->op = genop_jump_1;
+ jump->arity = 1;
+ jump->a[0] = Fail;
+ *prev_next = jump;
return op;
}
@@ -3272,7 +3355,6 @@ const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
int i;
ASSERT(Size.type == TAG_u);
- ASSERT(S.type == TAG_q);
NEW_GENOP(stp, op);
op->next = NULL;
@@ -3283,18 +3365,32 @@ const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail,
* Search for a literal matching the controlling expression.
*/
- if (S.type == TAG_q) {
- Eterm expr = stp->literals[S.val].term;
- for (i = 0; i < Size.val; i += 2) {
- if (Rest[i].type == TAG_q) {
- Eterm term = stp->literals[Rest[i].val].term;
- if (eq(term, expr)) {
- ASSERT(Rest[i+1].type == TAG_f);
- op->a[0] = Rest[i+1];
- return op;
+ switch (S.type) {
+ case TAG_q:
+ {
+ Eterm expr = stp->literals[S.val].term;
+ for (i = 0; i < Size.val; i += 2) {
+ if (Rest[i].type == TAG_q) {
+ Eterm term = stp->literals[Rest[i].val].term;
+ if (eq(term, expr)) {
+ ASSERT(Rest[i+1].type == TAG_f);
+ op->a[0] = Rest[i+1];
+ return op;
+ }
}
}
}
+ break;
+ case TAG_i:
+ case TAG_a:
+ for (i = 0; i < Size.val; i += 2) {
+ if (Rest[i].val == S.val && Rest[i].type == S.type) {
+ ASSERT(Rest[i+1].type == TAG_f);
+ op->a[0] = Rest[i+1];
+ return op;
+ }
+ }
+ break;
}
/*
@@ -3477,6 +3573,56 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
return op;
}
+static GenOp*
+tuple_append_put5(LoaderState* stp, GenOpArg Arity, GenOpArg Dst,
+ GenOpArg* Puts, GenOpArg S1, GenOpArg S2, GenOpArg S3,
+ GenOpArg S4, GenOpArg S5)
+{
+ GenOp* op;
+ int arity = Arity.val; /* Arity of tuple, not the instruction */
+ int i;
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ GENOP_ARITY(op, arity+2+5);
+ op->op = genop_i_put_tuple_2;
+ op->a[0] = Dst;
+ op->a[1].type = TAG_u;
+ op->a[1].val = arity + 5;
+ for (i = 0; i < arity; i++) {
+ op->a[i+2] = Puts[i];
+ }
+ op->a[arity+2] = S1;
+ op->a[arity+3] = S2;
+ op->a[arity+4] = S3;
+ op->a[arity+5] = S4;
+ op->a[arity+6] = S5;
+ return op;
+}
+
+static GenOp*
+tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst,
+ GenOpArg* Puts, GenOpArg S)
+{
+ GenOp* op;
+ int arity = Arity.val; /* Arity of tuple, not the instruction */
+ int i;
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ GENOP_ARITY(op, arity+2+1);
+ op->op = genop_i_put_tuple_2;
+ op->a[0] = Dst;
+ op->a[1].type = TAG_u;
+ op->a[1].val = arity + 1;
+ for (i = 0; i < arity; i++) {
+ op->a[i+2] = Puts[i];
+ }
+ op->a[arity+2] = S;
+ return op;
+}
+
+
/*
* Freeze the code in memory, move the string table into place,
@@ -3876,11 +4022,23 @@ transform_engine(LoaderState* st)
if (i == 0)
goto restart;
break;
+#if defined(TOP_is_eq)
case TOP_is_eq:
ASSERT(ap < instr->arity);
if (*pc++ != instr->a[ap].val)
goto restart;
break;
+#endif
+ case TOP_is_type_eq:
+ mask = *pc++;
+
+ ASSERT(ap < instr->arity);
+ ASSERT(instr->a[ap].type < BEAM_NUM_TAGS);
+ if (((1 << instr->a[ap].type) & mask) == 0)
+ goto restart;
+ if (*pc++ != instr->a[ap].val)
+ goto restart;
+ break;
case TOP_is_same_var:
ASSERT(ap < instr->arity);
i = *pc++;
@@ -4001,14 +4159,17 @@ transform_engine(LoaderState* st)
case TOP_rest_args:
{
int n = *pc++;
+ int formal_arity = gen_opc[instr->op].arity;
+ int num_vars = n + (instr->arity - formal_arity);
+ int j = formal_arity;
+
var = erts_alloc(ERTS_ALC_T_LOADER_TMP,
- instr->arity * sizeof(GenOpArg));
+ num_vars * sizeof(GenOpArg));
for (i = 0; i < n; i++) {
var[i] = def_vars[i];
}
- while (i < instr->arity) {
- var[i] = instr->a[i];
- i++;
+ while (i < num_vars) {
+ var[i++] = instr->a[j++];
}
}
break;
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 60b4b1946b..d9dd80fa8b 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -660,6 +660,7 @@ bif erts_debug:display/1
bif 'erl.system.debug':display/1 ebif_erts_debug_display_1
bif erts_debug:dist_ext_to_term/2
bif 'erl.system.debug':dist_ext_to_term/2 ebif_erts_debug_dist_ext_to_term_2
+bif erts_debug:instructions/0
#
# Monitor testing bif's...
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index a2439d5582..e861f97e7a 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -101,16 +101,16 @@ return
%macro: test_heap TestHeap -pack
allocate t t
-allocate_heap I I I
+allocate_heap t I t
deallocate I
init y
allocate_zero t t
-allocate_heap_zero I I I
+allocate_heap_zero t I t
trim N Remaining => i_trim N
i_trim I
-test_heap I I
+test_heap I t
allocate_heap S u==0 R => allocate S R
allocate_heap_zero S u==0 R => allocate_zero S R
@@ -124,7 +124,7 @@ init Y1 | init Y2 => init2 Y1 Y2
# Selecting values
-select_val S=q Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest)
+select_val S=aiq Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest)
select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \
gen_jump_tab(S, Fail, Size, Rest)
@@ -132,34 +132,59 @@ select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \
is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \
gen_jump_tab(S, Fail, Size, Rest)
+is_integer TypeFail=f S | select_val S=s Fail=f Size=u Rest=* | \
+ mixed_types(Size, Rest) => \
+ gen_split_values(S, TypeFail, Fail, Size, Rest)
+
select_val S=s Fail=f Size=u Rest=* | mixed_types(Size, Rest) => \
- gen_split_values(S, Fail, Size, Rest)
+ gen_split_values(S, Fail, Fail, Size, Rest)
-is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | \
+is_integer Fail=f S | select_val S=d Fail=f Size=u Rest=* | \
fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest)
-is_atom Fail=f S | select_val S=s Fail=f Size=u Rest=* | \
+is_atom Fail=f S | select_val S=d Fail=f Size=u Rest=* | \
fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest)
-select_val S=s Fail=f Size=u Rest=* | fixed_size_values(Size, Rest) => \
- gen_select_val(S, Fail, Size, Rest)
+select_val S=s Fail=f Size=u Rest=* | floats_or_bignums(Size, Rest) => \
+ gen_select_literals(S, Fail, Size, Rest)
-select_val S=s Fail=f Size=u Rest=* | all_values_are_big(Size, Rest) => \
- gen_select_big(S, Fail, Size, Rest)
+select_val S=d Fail=f Size=u Rest=* | fixed_size_values(Size, Rest) => \
+ gen_select_val(S, Fail, Size, Rest)
-is_tuple Fail=f S | select_tuple_arity S=s Fail=f Size=u Rest=* => \
+is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \
gen_select_tuple_arity(S, Fail, Size, Rest)
-select_tuple_arity S=s Fail=f Size=u Rest=* => \
+select_tuple_arity S=d Fail=f Size=u Rest=* => \
gen_select_tuple_arity(S, Fail, Size, Rest)
-i_select_val s f I
-i_select_tuple_arity s f I
-i_select_big s f
-i_select_float s f I
+i_select_val r f I
+i_select_val x f I
+i_select_val y f I
+
+i_select_val2 r f c f c f
+i_select_val2 x f c f c f
+i_select_val2 y f c f c f
+
+i_select_tuple_arity2 r f A f A f
+i_select_tuple_arity2 x f A f A f
+i_select_tuple_arity2 y f A f A f
+
+i_select_tuple_arity r f I
+i_select_tuple_arity x f I
+i_select_tuple_arity y f I
+
+i_jump_on_val_zero r f I
+i_jump_on_val_zero x f I
+i_jump_on_val_zero y f I
+
+i_jump_on_val r f I I
+i_jump_on_val x f I I
+i_jump_on_val y f I I
-i_jump_on_val_zero s f I
-i_jump_on_val s f I I
+jump Target | label Lbl | same_label(Target, Lbl) => label Lbl
+
+is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \
+ is_eq_exact Fail S1 S2 | label L2
%macro: get_list GetList -pack
get_list x x x
@@ -234,11 +259,17 @@ is_number Fail Literal=q => move Literal x | is_number Fail x
jump f
-case_end Literal=q => move Literal x | case_end x
-badmatch Literal=q => move Literal x | badmatch x
+case_end Literal=cq => move Literal x | case_end x
+badmatch Literal=cq => move Literal x | badmatch x
+
+case_end r
+case_end x
+case_end y
+
+badmatch r
+badmatch x
+badmatch y
-case_end s
-badmatch s
if_end
raise s s
@@ -248,12 +279,33 @@ system_limit j
move R R =>
+move C=cxy r | jump Lbl => move_jump Lbl C
+
+%macro: move_jump MoveJump -nonext
+move_jump f n
+move_jump f c
+move_jump f x
+move_jump f y
+
move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2
move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2
+move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4
+
+move C=aiq X=x==1 => move_x1 C
+move C=aiq X=x==2 => move_x2 C
+
+move_x1 c
+move_x2 c
%macro: move2 Move2 -pack
move2 x y x y
move2 y x y x
+move2 x x x x
+
+# The compiler almost never generates a "move Literal y(Y)" instruction,
+# so let's cheat if we encounter one.
+move S=n D=y => init D
+move S=c D=y => move S x | move x D
%macro:move Move -pack -gen_dest
move x x
@@ -265,15 +317,10 @@ move r x
move r y
move c r
move c x
-move c y
move n x
move n r
move y y
-%cold
-move s d
-%hot
-
# Receive operations.
loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src
@@ -306,55 +353,78 @@ i_wait_error_locked
send
#
-# Comparisions.
+# Optimized comparisons with one immediate/literal operand.
+#
+
+is_eq_exact Lbl R=rxy C=ian => i_is_eq_exact_immed Lbl R C
+is_eq_exact Lbl R=rxy C=q => i_is_eq_exact_literal R Lbl C
+
+is_ne_exact Lbl R=rxy C=ian => i_is_ne_exact_immed Lbl R C
+is_ne_exact Lbl R=rxy C=q => i_is_ne_exact_literal R Lbl C
+
+%macro: i_is_eq_exact_immed EqualImmed -fail_action
+i_is_eq_exact_immed f r c
+i_is_eq_exact_immed f x c
+i_is_eq_exact_immed f y c
+
+i_is_eq_exact_literal r f c
+i_is_eq_exact_literal x f c
+i_is_eq_exact_literal y f c
+
+%macro: i_is_ne_exact_immed NotEqualImmed -fail_action
+i_is_ne_exact_immed f r c
+i_is_ne_exact_immed f x c
+i_is_ne_exact_immed f y c
+
+i_is_ne_exact_literal r f c
+i_is_ne_exact_literal x f c
+i_is_ne_exact_literal y f c
+
+#
+# All other comparisons.
#
-is_eq_exact Lbl=f R=rxy C=ian => i_is_eq_immed Lbl R C
-is_eq Lbl=f R=rxy C=an => i_is_eq_immed Lbl R C
+is_eq_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl
+is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl
is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl
is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl
is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl
is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl
-is_eq_exact Lbl=f S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl
-is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl
-
+i_is_eq_exact f
+i_is_ne_exact f
i_is_lt f
i_is_ge f
i_is_eq f
i_is_ne f
-i_is_eq_exact f
-i_is_ne_exact f
-
-%macro: i_is_eq_immed EqualImmed -fail_action
-i_is_eq_immed f r c
-i_is_eq_immed f x c
-i_is_eq_immed f y c
#
# Putting things.
#
-put_tuple Arity Dst | put V => i_put_tuple Arity V Dst
+put_tuple Arity Dst => i_put_tuple Dst u
-%macro: i_put_tuple PutTuple -pack
-i_put_tuple A x x
-i_put_tuple A y x
-i_put_tuple A r x
-i_put_tuple A n x
-i_put_tuple A c x
-i_put_tuple A x y
-i_put_tuple A x r
-i_put_tuple A y r
-i_put_tuple A n r
-i_put_tuple A c r
+i_put_tuple Dst Arity Puts=* | put S1 | put S2 | \
+ put S3 | put S4 | put S5 => \
+ tuple_append_put5(Arity, Dst, Puts, S1, S2, S3, S4, S5)
-%cold
-i_put_tuple A r y
-i_put_tuple A y y
-i_put_tuple A c y
-%hot
+i_put_tuple Dst Arity Puts=* | put S => \
+ tuple_append_put(Arity, Dst, Puts, S)
+
+i_put_tuple/2
+
+%macro:i_put_tuple PutTuple -pack -goto:do_put_tuple
+i_put_tuple r I
+i_put_tuple x I
+i_put_tuple y I
+
+#
+# The instruction "put_list Const [] Dst" will not be generated by
+# the current BEAM compiler. But until R15A, play it safe by handling
+# that instruction with the following transformation.
+#
+put_list Const=c n Dst => move Const x | put_list x n Dst
%macro:put_list PutList -pack -gen_dest
@@ -362,10 +432,8 @@ put_list x n x
put_list y n x
put_list x x x
put_list y x x
-put_list c n x
put_list x x r
put_list y r r
-put_list c n r
put_list y y x
put_list x y x
@@ -376,6 +444,13 @@ put_list y y r
put_list y r x
put_list r n x
+put_list x r x
+put_list x y r
+put_list y x r
+put_list y x x
+
+put_list x r r
+
# put_list SrcReg Constant Dst
put_list r c r
put_list r c x
@@ -403,17 +478,9 @@ put_list c y x
put_list c y y
%cold
-put_list x r r
put_list s s d
%hot
-%macro: put Put
-put x
-put r
-put y
-put c
-put n
-
%macro: i_fetch FetchArgs -pack
i_fetch c c
i_fetch c r
@@ -464,19 +531,20 @@ move_return n r
move S r | deallocate D | return => move_deallocate_return S r D
-%macro: move_deallocate_return MoveDeallocateReturn -nonext
-move_deallocate_return x r P
-move_deallocate_return y r P
-move_deallocate_return c r P
-move_deallocate_return n r P
+%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext
+move_deallocate_return x r Q
+move_deallocate_return y r Q
+move_deallocate_return c r Q
+move_deallocate_return n r Q
deallocate D | return => deallocate_return D
%macro: deallocate_return DeallocateReturn -nonext
-deallocate_return P
+deallocate_return Q
test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y
+%macro: test_heap_1_put_list TestHeapPutList -pack
test_heap_1_put_list I y
# Test tuple & arity (head)
@@ -576,14 +644,14 @@ is_list f y
is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
-%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action
-is_nonempty_list_allocate f x I I
-is_nonempty_list_allocate f r I I
+%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack
+is_nonempty_list_allocate f x I t
+is_nonempty_list_allocate f r I t
is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2
-%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action
-is_non_empty_list_test_heap f r I I
+%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack
+is_non_empty_list_test_heap f r I t
%macro: is_nonempty_list IsNonemptyList -fail_action
is_nonempty_list f x
@@ -912,8 +980,13 @@ node x
node y
%hot
-i_fast_element j I s d
-i_element j s s d
+i_fast_element r j I d
+i_fast_element x j I d
+i_fast_element y j I d
+
+i_element r j s d
+i_element x j s d
+i_element y j s d
bif1 f b s d
bif1_body b s d
@@ -940,11 +1013,11 @@ move S r | call_last Ar P=f D => move_call_last S r P D
i_move_call_last f P c r
-%macro:move_call_last MoveCallLast -arg_f -nonext
+%macro:move_call_last MoveCallLast -arg_f -nonext -pack
move_call_last/4
-move_call_last x r f P
-move_call_last y r f P
+move_call_last x r f Q
+move_call_last y r f Q
move S=c r | call_only Ar P=f => i_move_call_only P S r
move S=x r | call_only Ar P=f => move_call_only S r P
@@ -1307,6 +1380,8 @@ fconv Arg=iqan Dst=l => move Arg x | fconv x Dst
fmove q l
fmove d l
+fmove l d
+
fconv d l
i_fadd l l l
@@ -1322,12 +1397,6 @@ fcheckerror p => i_fcheckerror
i_fcheckerror
fclearerror
-fmove FR=l Dst=d | new_float_allocation() => fmove_new FR Dst
-
-# The new instruction for moving a float out of a floating point register.
-# (No allocation.)
-fmove_new l d
-
#
# New apply instructions in R10B.
#
@@ -1336,7 +1405,21 @@ apply I
apply_last I P
#
-# New GCing arithmetic instructions.
+# Optimize addition and subtraction of small literals using
+# the i_increment/4 instruction (in bodies, not in guards).
+#
+
+gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=d Dst => \
+ gen_increment(Reg, Int, Live, Dst)
+gc_bif2 p Live u$bif:erlang:splus/2 Reg=d Int=i Dst => \
+ gen_increment(Reg, Int, Live, Dst)
+
+gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \
+ negation_is_small(Int) => \
+ gen_increment_from_minus(Reg, Int, Live, Dst)
+
+#
+# GCing arithmetic instructions.
#
gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst
@@ -1359,6 +1442,10 @@ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst
gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst
+i_increment r I I d
+i_increment x I I d
+i_increment y I I d
+
i_plus j I d
i_minus j I d
i_times j I d
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index 786fa7da77..6449c6f506 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -385,7 +385,6 @@ struct t_data
ErlDrvBinary *binp;
int size;
int offset;
- char name[1];
} read_file;
struct {
struct t_readdir_buf *first_buf;
@@ -1117,7 +1116,7 @@ static void invoke_read_file(void *data)
Sint64 size;
if (! (d->result_ok =
- efile_openfile(&d->errInfo, d->c.read_file.name,
+ efile_openfile(&d->errInfo, d->b,
EFILE_MODE_READ, &fd, &size))) {
goto done;
}
@@ -3071,7 +3070,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) {
d->command = command;
d->reply = !0;
/* Copy name */
- FILENAME_COPY(d->c.read_file.name, filename);
+ FILENAME_COPY(d->b, filename);
d->c.read_file.binp = NULL;
d->invoke = invoke_read_file;
d->free = free_read_file;
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index 228ff15341..32ac07cb2d 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -20,7 +20,8 @@
-module(beam_SUITE).
-export([all/1, packed_registers/1, apply_last/1, apply_last_bif/1,
- buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1]).
+ buildo_mucho/1, heap_sizes/1, big_lists/1, fconv/1,
+ select_val/1]).
-export([applied/2]).
@@ -28,7 +29,7 @@
all(suite) ->
[packed_registers, apply_last, apply_last_bif, buildo_mucho,
- heap_sizes, big_lists].
+ heap_sizes, big_lists, select_val].
%% Verify that apply(M, F, A) is really tail recursive.
@@ -302,3 +303,19 @@ do_fconv(nil, Float) when is_float(Float) ->
Float + [];
do_fconv(tuple_literal, Float) when is_float(Float) ->
Float + {a,b}.
+
+select_val(Config) when is_list(Config) ->
+ ?line zero = do_select_val(0),
+ ?line big = do_select_val(1 bsl 64),
+ ?line integer = do_select_val(42),
+ ok.
+
+do_select_val(X) ->
+ case X of
+ 0 ->
+ zero;
+ 1 bsl 64 ->
+ big;
+ Int when is_integer(Int) ->
+ integer
+ end.
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 75841adbfc..1eda939cf8 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -23,7 +23,8 @@
matching_bigs/1, matching_more_bigs/1,
matching_bigs_and_smalls/1, badmatch/1, case_clause/1,
receiving/1, literal_type_tests/1,
- put_list/1, fconv/1, literal_case_expression/1]).
+ put_list/1, fconv/1, literal_case_expression/1,
+ increment/1]).
-include("test_server.hrl").
@@ -32,7 +33,7 @@ all(suite) ->
matching_bigs, matching_more_bigs,
matching_bigs_and_smalls, badmatch, case_clause,
receiving, literal_type_tests,
- put_list, fconv, literal_case_expression].
+ put_list, fconv, literal_case_expression, increment].
putting(doc) -> "Test creating lists and tuples containing big number literals.";
putting(Config) when is_list(Config) ->
@@ -48,6 +49,7 @@ matching_bigs(doc) -> "Test matching of a few big number literals (in Beam,"
matching_bigs(Config) when is_list(Config) ->
a = matching1(3972907842873739),
b = matching1(-389789298378939783333333333333333333784),
+ other = matching1(3141699999999999999999999999999999999),
other = matching1(42).
matching_smalls(doc) -> "Test matching small numbers (both positive and negative).";
@@ -405,14 +407,51 @@ fconv_2(F) when is_float(F) ->
literal_case_expression(Config) when is_list(Config) ->
?line DataDir = ?config(data_dir, Config),
?line Src = filename:join(DataDir, "literal_case_expression"),
- ?line {ok,literal_case_expression=Mod,Code} = compile:file(Src, [from_asm,binary]),
+ ?line {ok,literal_case_expression=Mod,Code} =
+ compile:file(Src, [from_asm,binary]),
?line {module,Mod} = code:load_binary(Mod, Src, Code),
?line ok = Mod:x(),
?line ok = Mod:y(),
+ ?line ok = Mod:zi1(),
+ ?line ok = Mod:zi2(),
+ ?line ok = Mod:za1(),
+ ?line ok = Mod:za2(),
?line true = code:delete(Mod),
?line code:purge(Mod),
ok.
+%% Test the i_increment instruction.
+increment(Config) when is_list(Config) ->
+ %% In the 32-bit emulator, Neg32 can be represented as a small,
+ %% but -Neg32 cannot. Therefore the i_increment instruction must
+ %% not be used in the subtraction that follows (since i_increment
+ %% cannot handle a bignum literal).
+ Neg32 = -(1 bsl 27),
+ Big32 = id(1 bsl 32),
+ Result32 = (1 bsl 32) + (1 bsl 27),
+ ?line Result32 = Big32 + (1 bsl 27),
+ ?line Result32 = Big32 - Neg32,
+
+ %% Same thing, but for the 64-bit emulator.
+ Neg64 = -(1 bsl 59),
+ Big64 = id(1 bsl 64),
+ Result64 = (1 bsl 64) + (1 bsl 59),
+ ?line Result64 = Big64 + (1 bsl 59),
+ ?line Result64 = Big64 - Neg64,
+
+ %% Test error handling for the i_increment instruction.
+ Bad = id(bad),
+ ?line {'EXIT',{badarith,_}} = (catch Bad + 42),
+
+ %% Small operands, but a big result.
+ Res32 = 1 bsl 27,
+ Small32 = id(Res32-1),
+ ?line Res32 = Small32 + 1,
+ Res64 = 1 bsl 59,
+ Small64 = id(Res64-1),
+ ?line Res64 = Small64 + 1,
+ ok.
+
%% Help functions.
chksum(Term) ->
diff --git a/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S b/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S
index c0ffe9ab53..bfdfc079dc 100644
--- a/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S
+++ b/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S
@@ -1,10 +1,11 @@
{module, literal_case_expression}. %% version = 0
-{exports, [{module_info,0},{module_info,1},{x,0},{y,0}]}.
+{exports, [{module_info,0},{module_info,1},{x,0},{y,0},
+ {zi1,0},{zi2,0},{za1,0},{za2,0}]}.
{attributes, []}.
-{labels, 15}.
+{labels, 32}.
{function, x, 0, 2}.
@@ -52,6 +53,81 @@
{label,10}.
{case_end,{float,34.0000}}.
+{function, zi1, 0, 16}.
+ {label,15}.
+ {func_info,{atom,literal_case_expression},{atom,zi1},0}.
+ {label,16}.
+ {test,is_integer,{f,19},[{integer,42}]}.
+ {select_val,{integer,42},
+ {f,18},
+ {list,[{integer,42},
+ {f,17},
+ {integer,1000},
+ {f,18}]}}.
+ {label,17}.
+ {move,{atom,ok},{x,0}}.
+ return.
+ {label,18}.
+ {move,{atom,error},{x,0}}.
+ return.
+ {label,19}.
+ {case_end,{integer,42}}.
+
+{function, zi2, 0, 16}.
+ {label,20}.
+ {func_info,{atom,literal_case_expression},{atom,zi2},0}.
+ {label,21}.
+ {test,is_integer,{f,23},[{integer,42}]}.
+ {select_val,{integer,42},
+ {f,23},
+ {list,[{integer,42},
+ {f,22},
+ {integer,1000},
+ {f,23}]}}.
+ {label,22}.
+ {move,{atom,ok},{x,0}}.
+ return.
+ {label,23}.
+ {move,{atom,error},{x,0}}.
+ return.
+
+{function, za1, 0, 25}.
+ {label,24}.
+ {func_info,{atom,literal_case_expression},{atom,za1},0}.
+ {label,25}.
+ {test,is_atom,{f,28},[{atom,x}]}.
+ {select_val,{atom,x},
+ {f,27},
+ {list,[{atom,a},
+ {f,27},
+ {atom,x},
+ {f,26}]}}.
+ {label,26}.
+ {move,{atom,ok},{x,0}}.
+ return.
+ {label,27}.
+ {move,{atom,error},{x,0}}.
+ return.
+ {label,28}.
+ {case_end,{atom,x}}.
+
+{function, za2, 0, 30}.
+ {label,29}.
+ {func_info,{atom,literal_case_expression},{atom,za2},0}.
+ {label,30}.
+ {test,is_atom,{f,32},[{atom,x}]}.
+ {select_val,{atom,x},
+ {f,32},
+ {list,[{atom,a},
+ {f,32},
+ {atom,x},
+ {f,31}]}}.
+ {label,31}.
+ {move,{atom,ok},{x,0}}.
+ return.
+ {label,32}.
+ {move,{atom,error},{x,0}}.
+ return.
{function, module_info, 0, 12}.
{label,11}.
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index e60a999df1..934a1b10a4 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -21,10 +21,10 @@
-include("test_server.hrl").
-export([all/1,init_per_testcase/2,fin_per_testcase/2,
- flat_size/1,flat_size_big/1,df/1]).
+ flat_size/1,flat_size_big/1,df/1,instructions/1]).
all(suite) ->
- [flat_size,flat_size_big,df].
+ [flat_size,flat_size_big,df,instructions].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(2)),
@@ -70,3 +70,8 @@ df(Config) when is_list(Config) ->
pps() ->
{erlang:ports()}.
+
+instructions(Config) when is_list(Config) ->
+ ?line Is = erts_debug:instructions(),
+ ?line _ = [list_to_atom(I) || I <- Is],
+ ok.
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index de19a2e35b..e7c57142c0 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -27,6 +27,7 @@ my $outdir = "."; # Directory for output files.
my $verbose = 0;
my $hot = 1;
my $num_file_opcodes = 0;
+my $wordsize = 32;
# This is shift counts and mask for the packer.
my $WHOLE_WORD = '';
@@ -36,12 +37,20 @@ my @pack_mask;
$pack_instr[2] = ['6', 'i'];
$pack_instr[3] = ['0', '0', 'i'];
+$pack_instr[4] = ['6', '6', '6', 'i']; # Only for 64 bit wordsize
$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT'];
$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)'];
+$pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize
+ '(2*BEAM_LOOSE_SHIFT)',
+ '(3*BEAM_LOOSE_SHIFT)'];
$pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD];
$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK'];
+$pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize
+ 'BEAM_LOOSE_MASK',
+ 'BEAM_LOOSE_MASK',
+ $WHOLE_WORD];
# There are two types of instructions: generic and specific.
# The generic instructions are those generated by the Beam compiler.
@@ -80,6 +89,8 @@ my %cold_code;
my @unnumbered_generic;
my %unnumbered;
+my %is_transformed;
+
#
# Code transformations.
#
@@ -118,7 +129,8 @@ my %arg_size = ('r' => 0, # x(0) - x register zero
't' => 1, # untagged integer -- can be packed
'b' => 1, # pointer to bif
'A' => 1, # arity value
- 'P' => 1, # byte offset into tuple
+ 'P' => 1, # byte offset into tuple or stack
+ 'Q' => 1, # like 'P', but packable
'h' => 1, # character
'l' => 1, # float reg
'q' => 1, # literal term
@@ -157,6 +169,7 @@ my @tag_type;
$type_bit{'U'} = $type_bit{'u'};
$type_bit{'e'} = $type_bit{'u'};
$type_bit{'P'} = $type_bit{'u'};
+ $type_bit{'Q'} = $type_bit{'u'};
}
#
@@ -169,6 +182,7 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) {
($target = \&emulator_output), next if /^emulator/;
($target = \&compiler_output), next if /^compiler/;
($outdir = shift), next if /^outdir/;
+ ($wordsize = shift), next if /^wordsize/;
($verbose = 1), next if /^v/;
die "$0: Bad option: -$_\n";
}
@@ -474,8 +488,9 @@ sub emulator_output {
$gen_transform_offset{$key} : -1;
my($spec_op) = $gen_to_spec{$key};
my($num_specific) = $num_specific{$key};
- defined $spec_op or $tr != -1 or
+ defined $spec_op or
$obsolete[$gen_opnum{$name,$arity}] or
+ $is_transformed{$name,$arity} or
error("instruction $key has no specific instruction");
$spec_op = -1 unless defined $spec_op;
&init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key});
@@ -498,12 +513,14 @@ sub emulator_output {
print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n";
print "\n";
print "#ifdef ARCH_64\n";
+ print "# define BEAM_WIDE_MASK 0xFFFFUL\n";
print "# define BEAM_LOOSE_MASK 0x1FFFUL\n";
print "#if HALFWORD_HEAP\n";
print "# define BEAM_TIGHT_MASK 0x1FFCUL\n";
print "#else\n";
print "# define BEAM_TIGHT_MASK 0x1FF8UL\n";
print "#endif\n";
+ print "# define BEAM_WIDE_SHIFT 32\n";
print "# define BEAM_LOOSE_SHIFT 16\n";
print "# define BEAM_TIGHT_SHIFT 16\n";
print "#else\n";
@@ -796,6 +813,7 @@ sub basic_generator {
'I' => 1,
't' => 1,
'P' => 1,
+ 'Q' => 1,
);
# Pick up the macro to use and its flags (if any).
@@ -916,7 +934,18 @@ sub basic_generator {
$var_decls .= "BeamInstr tmp_packed2;"
if $macro_code =~ /tmp_packed2/;
if ($flags =~ /-nonext/) {
- $code = "$macro_code\n";
+ $code = join("\n",
+ "{ $var_decls",
+ $macro_code,
+ "}");
+ } elsif ($flags =~ /-goto:(\S*)/) {
+ my $goto = $1;
+ $code = join("\n",
+ "{ $var_decls",
+ $macro_code,
+ "I += $size + 1;",
+ "goto $goto;",
+ "}");
} else {
$code = join("\n",
"{ $var_decls",
@@ -935,18 +964,31 @@ sub basic_generator {
sub do_pack {
my(@args) = @_;
- my($i);
my($packable_args) = 0;
+ my @is_packable; # Packability (boolean) for each argument.
+ my $wide_packing = 0;
#
# Count the number of packable arguments. If we encounter any 's' or 'd'
# arguments, packing is not possible.
#
- for ($i = 0; $i < @args; $i++) {
- if ($args[$i] =~ /[xyt]/) {
+ my $packable_types = "xytQ";
+ foreach my $arg (@args) {
+ if ($arg =~ /^[$packable_types]/) {
$packable_args++;
- } elsif ($args[$i] =~ /[sd]/) {
+ push @is_packable, 1;
+ } elsif ($arg =~ /^I/ and $wordsize == 64 and $packable_args < 2) {
+ $wide_packing = 1;
+ push @is_packable, 1;
+ if (++$packable_args == 2) {
+ # We can only pack two arguments. Turn off packing
+ # for the rest of the arguments.
+ $packable_types = "\xFF";
+ }
+ } elsif ($arg =~ /^[sd]/) {
return ('', '', @args);
+ } else {
+ push @is_packable, 0;
}
}
@@ -962,10 +1004,27 @@ sub do_pack {
# beginning).
my($up) = ''; # Pack commands (storing back while
# moving forward).
- my($args_per_word) = $packable_args < 4 ? $packable_args : 2;
- my(@shift) = @{$pack_shift[$args_per_word]};
- my(@mask) = @{$pack_mask[$args_per_word]};
- my(@pack_instr) = @{$pack_instr[$args_per_word]};
+ my $args_per_word;
+ if ($packable_args < 4 or $wordsize == 64) {
+ $args_per_word = $packable_args;
+ } else {
+ # 4 packable argument, 32 bit wordsize. Need 2 words.
+ $args_per_word = 2;
+ }
+
+ my @shift;
+ my @mask;
+ my @instr;
+
+ if ($wide_packing) {
+ @shift = ('0', 'BEAM_WIDE_SHIFT');
+ @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD);
+ @instr = ('w', 'i');
+ } else {
+ @shift = @{$pack_shift[$args_per_word]};
+ @mask = @{$pack_mask[$args_per_word]};
+ @instr = @{$pack_instr[$args_per_word]};
+ }
#
# Now generate the packing instructions. One complication is that
@@ -979,10 +1038,10 @@ sub do_pack {
my($ap) = 0; # Argument number within word.
my($tmpnum) = 1; # Number of temporary variable.
my($expr) = '';
- for ($i = 0; $i < @args; $i++) {
+ for (my $i = 0; $i < @args; $i++) {
my($reg) = $args[$i];
my($this_size) = $arg_size{$reg};
- if ($reg =~ /[xyt]/) {
+ if ($is_packable[$i]) {
$this_size = 0;
$did_some_packing = 1;
@@ -993,7 +1052,7 @@ sub do_pack {
$this_size = 1;
}
- $down = "$pack_instr[$ap]$down";
+ $down = "$instr[$ap]$down";
my($unpack) = &make_unpack($tmpnum, $shift[$ap], $mask[$ap]);
$args[$i] = "pack:$this_size:$reg" . "b($unpack)";
@@ -1103,6 +1162,10 @@ sub compile_transform {
if ($obsolete[$gen_opnum{$name,$arity}]) {
error("obsolete function must not be used in transformations");
}
+
+ if ($src) {
+ $is_transformed{$name,$arity} = 1;
+ }
[$name,$arity,@ops];
}
@@ -1291,13 +1354,28 @@ sub tr_gen_from {
my($var, $type, $type_val, $cond, $val) = @$op;
if ($type ne '' && $type ne '*') {
- my($types) = '';
- my($type_mask) = 0;
- foreach (split('', $type)) {
- $types .= "$_ ";
- $type_mask |= $type_bit{$_};
+ #
+ # The is_bif, is_not_bif, and is_func instructions have
+ # their own built-in type test and don't need to
+ # be guarded with a type test instruction.
+ #
+ unless ($cond eq 'is_bif' or
+ $cond eq 'is_not_bif' or
+ $cond eq 'is_func') {
+ my($types) = '';
+ my($type_mask) = 0;
+ foreach (split('', $type)) {
+ $types .= "$_ ";
+ $type_mask |= $type_bit{$_};
+ }
+ if ($cond ne 'is_eq') {
+ push(@code, &make_op($types, 'is_type', $type_mask));
+ } else {
+ $cond = '';
+ push(@code, &make_op($types, 'is_type_eq',
+ $type_mask, $val));
+ }
}
- push(@code, &make_op($types, 'is_type', $type_mask));
}
if ($cond eq 'is_func') {
diff --git a/erts/emulator/utils/count b/erts/emulator/utils/count
new file mode 100755
index 0000000000..617f5c25e8
--- /dev/null
+++ b/erts/emulator/utils/count
@@ -0,0 +1,127 @@
+%% -*- erlang -*-
+%%
+%% %CopyrightBegin%
+%%
+%% 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%
+%%
+
+-mode(compile).
+
+main(_) ->
+ DisDir = "./dis",
+ ok = filelib:ensure_dir(filename:join(DisDir, "dummy")),
+ io:format("Dissambling to ~s\n", [DisDir]),
+ ok = file:set_cwd(DisDir),
+ Path = code:get_path() -- ["."],
+ Beams0 = [filelib:wildcard(filename:join(Dir, "*.beam")) ||
+ Dir <- Path],
+ Beams = lists:append(Beams0),
+ Mods0 = [list_to_atom(filename:rootname(filename:basename(F))) ||
+ F <- Beams],
+ Mods = lists:usort(Mods0),
+ start_sem(),
+ Ps = [begin
+ {_,Ref} = spawn_monitor(fun() -> count(M) end),
+ Ref
+ end || M <- Mods],
+ [put(list_to_atom(I), 0) || I <- erts_debug:instructions()],
+ Res = wait_for_all(Ps, 1),
+ OutFile = "count",
+ {ok,Out} = file:open(OutFile, [write]),
+ [io:format(Out, "~s ~p\n", [I,C]) || {I,C} <- Res],
+ ok = file:close(Out),
+ io:format("\nResult written to ~s\n",
+ [filename:join(DisDir, OutFile)]),
+ ok.
+
+wait_for_all([], _) ->
+ lists:reverse(lists:keysort(2, get()));
+wait_for_all([_|_]=Ps, I) ->
+ receive
+ {'DOWN',Ref,process,_,Result} ->
+ io:format("\r~p", [I]),
+ [increment(Key, Count) || {Key,Count} <- Result],
+ wait_for_all(Ps -- [Ref], I+1)
+ end.
+
+count(M) ->
+ down(),
+ erts_debug:df(M),
+ {ok,Fd} = file:open(atom_to_list(M) ++ ".dis", [read,raw]),
+ count_is(Fd),
+ ok = file:close(Fd),
+ exit(get()).
+
+count_is(Fd) ->
+ case file:read_line(Fd) of
+ {ok,Line} ->
+ count_instr(Line),
+ count_is(Fd);
+ eof ->
+ ok
+ end.
+
+count_instr([$\s|T]) ->
+ count_instr_1(T, []);
+count_instr([_|T]) ->
+ count_instr(T);
+count_instr([]) ->
+ %% Empty line.
+ ok.
+
+count_instr_1([$\s|_], Acc) ->
+ Instr = list_to_atom(lists:reverse(Acc)),
+ increment(Instr, 1);
+count_instr_1([H|T], Acc) ->
+ count_instr_1(T, [H|Acc]).
+
+increment(Key, Inc) ->
+ case get(Key) of
+ undefined ->
+ put(Key, Inc);
+ Count ->
+ put(Key, Count+Inc)
+ end.
+
+%%%
+%%% Counting sempahore to limit the number of processes that
+%%% can run concurrently.
+%%%
+
+down() ->
+ sem ! {down,self()},
+ receive
+ sem_taken -> ok
+ end.
+
+start_sem() ->
+ spawn(fun() ->
+ register(sem, self()),
+ process_flag(trap_exit, true),
+ do_sem(erlang:system_info(schedulers)+1) end).
+
+do_sem(0) ->
+ receive
+ {'EXIT',_,_} ->
+ do_sem(1)
+ end;
+do_sem(C) ->
+ receive
+ {down,Pid} ->
+ link(Pid),
+ Pid ! sem_taken,
+ do_sem(C-1)
+ end.
diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c
index ef471a473a..3499ab2934 100644
--- a/erts/epmd/src/epmd_srv.c
+++ b/erts/epmd/src/epmd_srv.c
@@ -2,7 +2,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -157,8 +157,10 @@ void run(EpmdVars *g)
dbg_printf(g,2,"starting");
- listen(listensock, SOMAXCONN);
-
+ if(listen(listensock, SOMAXCONN) < 0) {
+ dbg_perror(g,"failed to listen on socket");
+ epmd_cleanup_exit(g,1);
+ }
FD_ZERO(&g->orig_read_mask);
FD_SET(listensock,&g->orig_read_mask);
diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml
index d7af7a1b67..de4e4b4301 100644
--- a/lib/erl_interface/doc/src/ei.xml
+++ b/lib/erl_interface/doc/src/ei.xml
@@ -641,12 +641,14 @@ ei_x_encode_empty_list(&amp;x);
<p></p>
<pre>
~a - an atom, char*
+~c - a character, char
~s - a string, char*
~i - an integer, int
~l - a long integer, long int
~u - a unsigned long integer, unsigned long int
~f - a float, float
~d - a double float, double float
+~p - an Erlang PID, erlang_pid*
</pre>
<p>For instance, to encode a tuple with some stuff:</p>
<pre>
diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h
index 0c72ab977a..ae815b414a 100644
--- a/lib/erl_interface/include/ei.h
+++ b/lib/erl_interface/include/ei.h
@@ -80,21 +80,24 @@
#define ERL_NO_TIMEOUT -1
/* these are the control message types */
-#define ERL_LINK 1
-#define ERL_SEND 2
-#define ERL_EXIT 3
-#define ERL_UNLINK 4
-
-#define ERL_REG_SEND 6
-#define ERL_GROUP_LEADER 7
-#define ERL_EXIT2 8
-#define ERL_PASS_THROUGH 'p'
+#define ERL_LINK 1
+#define ERL_SEND 2
+#define ERL_EXIT 3
+#define ERL_UNLINK 4
+#define ERL_NODE_LINK 5
+#define ERL_REG_SEND 6
+#define ERL_GROUP_LEADER 7
+#define ERL_EXIT2 8
+#define ERL_PASS_THROUGH 'p'
/* new ones for tracing, from Kenneth */
-#define ERL_SEND_TT 12
-#define ERL_EXIT_TT 13
-#define ERL_REG_SEND_TT 16
-#define ERL_EXIT2_TT 18
+#define ERL_SEND_TT 12
+#define ERL_EXIT_TT 13
+#define ERL_REG_SEND_TT 16
+#define ERL_EXIT2_TT 18
+#define ERL_MONITOR_P 19
+#define ERL_DEMONITOR_P 20
+#define ERL_MONITOR_P_EXIT 21
/* -------------------------------------------------------------------- */
diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c
index 53b0e0426b..6dc6ebb348 100644
--- a/lib/erl_interface/src/connect/ei_connect.c
+++ b/lib/erl_interface/src/connect/ei_connect.c
@@ -1328,6 +1328,7 @@ static int send_name_or_challenge(int fd, char *nodename,
put8(s, 'n');
put16be(s, version);
put32be(s, (DFLAG_EXTENDED_REFERENCES
+ | DFLAG_DIST_MONITOR
| DFLAG_EXTENDED_PIDS_PORTS
| DFLAG_FUN_TAGS
| DFLAG_NEW_FUN_TAGS
diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c
index a6c2f64dd0..70949a7adf 100644
--- a/lib/erl_interface/src/legacy/erl_marshal.c
+++ b/lib/erl_interface/src/legacy/erl_marshal.c
@@ -1646,11 +1646,14 @@ static int cmp_exe2(unsigned char **e1, unsigned char **e2)
min = (i < j) ? i : j;
k = 0;
while (1) {
- if (k++ == min)
- return compare_top_ext(e1 , e2);
- if ((ret = compare_top_ext(e1 , e2)) == 0)
- continue;
- return ret;
+ if (k++ == min){
+ if (i == j) return 0;
+ if (i < j) return -1;
+ return 1;
+ }
+ if ((ret = compare_top_ext(e1 , e2)) == 0)
+ continue;
+ return ret;
}
case ERL_STRING_EXT:
i = (**e1 << 8) | ((*e1)[1]);
diff --git a/lib/erl_interface/src/legacy/global_register.c b/lib/erl_interface/src/legacy/global_register.c
index 3a4de8b08e..f12eb6b448 100644
--- a/lib/erl_interface/src/legacy/global_register.c
+++ b/lib/erl_interface/src/legacy/global_register.c
@@ -31,7 +31,7 @@ int erl_global_register(int fd, const char *name, ETERM *pid)
int index = 0;
erlang_pid self;
erlang_msg msg;
- int needlink, needatom;
+ int needlink, needatom, needmonitor;
int arity;
int version;
int msglen;
@@ -65,7 +65,7 @@ int erl_global_register(int fd, const char *name, ETERM *pid)
if (ei_send_reg_encoded(fd,&self,"rex",buf,index)) return -1;
/* get the reply: expect link and an atom, or just an atom */
- needlink = needatom = 1;
+ needlink = needatom = needmonitor = 1;
while (1) {
/* get message */
while (1) {
@@ -78,9 +78,15 @@ int erl_global_register(int fd, const char *name, ETERM *pid)
case ERL_LINK:
/* got link */
if (!needlink) return -1;
- needlink = 0;
+ needlink = 0;
break;
+ case ERL_MONITOR_P-10:
+ /* got monitor */
+ if (!needmonitor) { return -1;}
+ needmonitor = 0;
+ break;
+
case ERL_SEND:
/* got message - does it contain our atom? */
if (!needatom) return -1;
diff --git a/lib/erl_interface/src/legacy/global_unregister.c b/lib/erl_interface/src/legacy/global_unregister.c
index 514dbc3c68..97a1c2d03c 100644
--- a/lib/erl_interface/src/legacy/global_unregister.c
+++ b/lib/erl_interface/src/legacy/global_unregister.c
@@ -37,7 +37,7 @@ int erl_global_unregister(int fd, const char *name)
erlang_msg msg;
int i;
int version,arity,msglen;
- int needunlink, needatom;
+ int needunlink, needatom, needdemonitor;
/* make a self pid */
self->num = fd;
@@ -57,7 +57,7 @@ int erl_global_unregister(int fd, const char *name)
if (ei_send_reg_encoded(fd,self,"rex",buf,index)) return -1;
/* get the reply: expect unlink and an atom, or just an atom */
- needunlink = needatom = 1;
+ needunlink = needatom = needdemonitor = 1;
while (1) {
/* get message */
while (1) {
@@ -68,11 +68,17 @@ int erl_global_unregister(int fd, const char *name)
switch (i) {
case ERL_UNLINK:
- /* got link */
+ /* got unlink */
if (!needunlink) return -1;
needunlink = 0;
break;
+ case ERL_DEMONITOR_P-10:
+ /* got demonitor */
+ if (!needdemonitor) return -1;
+ needdemonitor = 0;
+ break;
+
case ERL_SEND:
/* got message - does it contain our atom? */
if (!needatom) return -1;
diff --git a/lib/erl_interface/src/misc/ei_format.c b/lib/erl_interface/src/misc/ei_format.c
index b35421d4b2..dbd7a4479a 100644
--- a/lib/erl_interface/src/misc/ei_format.c
+++ b/lib/erl_interface/src/misc/ei_format.c
@@ -47,10 +47,12 @@
* array of unions.
*/
union arg {
+ char c;
char* s;
long l;
unsigned long u;
double d;
+ erlang_pid* pid;
};
static int eiformat(const char** s, union arg** args, ei_x_buff* x);
@@ -224,12 +226,14 @@ static int pquotedatom(const char** fmt, ei_x_buff* x)
/*
* The format letters are:
* a - An atom
+ * c - A character
* s - A string
* i - An integer
* l - A long integer
* u - An unsigned long integer
* f - A float
* d - A double float
+ * p - An Erlang PID
*/
static int pformat(const char** fmt, union arg** args, ei_x_buff* x)
{
@@ -240,6 +244,10 @@ static int pformat(const char** fmt, union arg** args, ei_x_buff* x)
res = ei_x_encode_atom(x, (*args)->s);
(*args)++;
break;
+ case 'c':
+ res = ei_x_encode_char(x, (*args)->c);
+ (*args)++;
+ break;
case 's':
res = ei_x_encode_string(x, (*args)->s);
(*args)++;
@@ -261,6 +269,10 @@ static int pformat(const char** fmt, union arg** args, ei_x_buff* x)
res = ei_x_encode_double(x, (*args)->d);
(*args)++;
break;
+ case 'p':
+ res = ei_x_encode_pid(x, (*args)->pid);
+ (*args)++;
+ break;
default:
res = -1;
break;
@@ -396,6 +408,9 @@ static int read_args(const char* fmt, va_list ap, union arg **argp)
return -1; /* Error, string not complete */
}
switch (*p++) {
+ case 'c':
+ args[i++].c = (char) va_arg(ap, int);
+ break;
case 'a':
case 's':
args[i++].s = va_arg(ap, char*);
@@ -415,6 +430,9 @@ static int read_args(const char* fmt, va_list ap, union arg **argp)
case 'd':
args[i++].d = va_arg(ap, double);
break;
+ case 'p':
+ args[i++].pid = va_arg(ap, erlang_pid*);
+ break;
default:
ei_free(args); /* Invalid specifier */
return -1;
diff --git a/lib/erl_interface/test/Makefile b/lib/erl_interface/test/Makefile
index b7a1a4e4d8..07404fda4d 100644
--- a/lib/erl_interface/test/Makefile
+++ b/lib/erl_interface/test/Makefile
@@ -33,6 +33,7 @@ MODULES= \
ei_print_SUITE \
ei_tmo_SUITE \
erl_connect_SUITE \
+ erl_global_SUITE \
erl_eterm_SUITE \
erl_ext_SUITE \
erl_format_SUITE \
diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl
index fe82a73ef9..3c72188e16 100644
--- a/lib/erl_interface/test/ei_connect_SUITE.erl
+++ b/lib/erl_interface/test/ei_connect_SUITE.erl
@@ -30,6 +30,7 @@
ei_send/1,
ei_reg_send/1,
+ ei_format_pid/1,
ei_rpc/1,
rpc_test/1,
ei_send_funs/1,
@@ -41,6 +42,7 @@
all(suite) -> [ ei_send,
ei_reg_send,
+ ei_format_pid,
ei_rpc,
ei_send_funs,
ei_threaded_send,
@@ -67,6 +69,19 @@ ei_send(Config) when is_list(Config) ->
?line runner:recv_eot(P),
ok.
+ei_format_pid(Config) when is_list(Config) ->
+ ?line S = self(),
+ ?line P = runner:start(?interpret),
+ ?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
+ ?line {ok,Fd} = ei_connect(P, node()),
+
+ ?line ok = ei_format_pid(P, Fd, S),
+ ?line receive S -> ok end,
+
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
ei_send_funs(Config) when is_list(Config) ->
?line P = runner:start(?interpret),
?line 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0),
@@ -189,6 +204,10 @@ ei_send(P, Fd, To, Msg) ->
send_command(P, ei_send, [Fd,To,Msg]),
get_send_result(P).
+ei_format_pid(P, Fd, To) ->
+ send_command(P, ei_format_pid, [Fd, To]),
+ get_send_result(P).
+
ei_send_funs(P, Fd, To, Msg) ->
send_command(P, ei_send_funs, [Fd,To,Msg]),
get_send_result(P).
diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
index debd3e789b..8183ac9dd8 100644
--- a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
+++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
@@ -35,6 +35,7 @@
static void cmd_ei_connect_init(char* buf, int len);
static void cmd_ei_connect(char* buf, int len);
static void cmd_ei_send(char* buf, int len);
+static void cmd_ei_format_pid(char* buf, int len);
static void cmd_ei_send_funs(char* buf, int len);
static void cmd_ei_reg_send(char* buf, int len);
static void cmd_ei_rpc(char* buf, int len);
@@ -57,6 +58,7 @@ static struct {
"ei_reg_send", 3, cmd_ei_reg_send,
"ei_rpc", 4, cmd_ei_rpc,
"ei_set_get_tracelevel", 1, cmd_ei_set_get_tracelevel,
+ "ei_format_pid", 2, cmd_ei_format_pid,
};
@@ -111,7 +113,7 @@ static void cmd_ei_connect_init(char* buf, int len)
ei_x_buff res;
if (ei_decode_long(buf, &index, &l) < 0)
fail("expected int");
- sprintf(b, "c%d", l);
+ sprintf(b, "c%ld", l);
/* FIXME don't use internal and maybe use skip?! */
ei_get_type_internal(buf, &index, &type, &size);
if (ei_decode_atom(buf, &index, cookie) < 0)
@@ -183,6 +185,25 @@ static void cmd_ei_send(char* buf, int len)
ei_x_free(&x);
}
+static void cmd_ei_format_pid(char* buf, int len)
+{
+ int index = 0;
+ long fd;
+ erlang_pid pid;
+ ei_x_buff x;
+
+ if (ei_decode_long(buf, &index, &fd) < 0)
+ fail("expected long");
+ if (ei_decode_pid(buf, &index, &pid) < 0)
+ fail("expected pid (node)");
+ if (ei_x_new_with_version(&x) < 0)
+ fail("ei_x_new_with_version");
+ if (ei_x_format_wo_ver(&x, "~p", &pid) < 0)
+ fail("ei_x_format_wo_ver");
+ send_errno_result(ei_send(fd, &pid, x.buff, x.index));
+ ei_x_free(&x);
+}
+
static void cmd_ei_send_funs(char* buf, int len)
{
int index = 0, n;
diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl
index cbe9fa52d7..6d44e0adf3 100644
--- a/lib/erl_interface/test/ei_format_SUITE.erl
+++ b/lib/erl_interface/test/ei_format_SUITE.erl
@@ -155,7 +155,7 @@ format_wo_ver(suite) -> [];
format_wo_ver(Config) when is_list(Config) ->
?line P = runner:start(?format_wo_ver),
- ?line {term, [-1, 2, {a, "b"}, {c, 10}]} = get_term(P),
+ ?line {term, [-1, 2, $c, {a, "b"}, {c, 10}]} = get_term(P),
?line runner:recv_eot(P),
ok.
diff --git a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
index ecdce402f5..a6eeb25abc 100644
--- a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
+++ b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
@@ -176,7 +176,7 @@ TESTCASE(format_wo_ver) {
ei_x_buff x;
ei_x_new (&x);
- ei_x_format(&x, "[-1, +2, {~a,~s},{~a,~i}]", "a", "b", "c", 10);
+ ei_x_format(&x, "[-1, +2, ~c, {~a,~s},{~a,~i}]", 'c', "a", "b", "c", 10);
send_bin_term(&x);
free(x.buff);
diff --git a/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c b/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c
index ba1a6c66da..59e0e0cce7 100644
--- a/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c
+++ b/lib/erl_interface/test/erl_ext_SUITE_data/ext_test.c
@@ -82,6 +82,11 @@ TESTCASE(compare_list) {
// erlang:term_to_binary([34,{a,n},a,erlang])
unsigned char term2[] = {131,108,0,0,0,4,97,34,104,2,100,0,1,97,100,0,1,110,100,0,1,97,100,0,6,101,114,108,97,110,103,106};
+ // erlang:term_to_binary([0])
+ unsigned char term3[] = {131,107,0,1,0};
+ // erlang:term_to_binary([0, 1000])
+ unsigned char term4[] = {131,108,0,0,0,2,97,0,98,0,0,3,232,106};
+
erl_init(NULL, 0);
start_a = term1;
start_b = term2;
@@ -90,6 +95,13 @@ TESTCASE(compare_list) {
test_compare_ext("lists", start_a, end_a, start_b, end_b, 1);
+ start_a = term3;
+ start_b = term4;
+ end_a = term3 + sizeof(term3);
+ end_b = term4 + sizeof(term4);
+
+ test_compare_ext("lists1", start_a, end_a, start_b, end_b, -1);
+
report(1);
}
diff --git a/lib/erl_interface/test/erl_global_SUITE.erl b/lib/erl_interface/test/erl_global_SUITE.erl
new file mode 100644
index 0000000000..4f332037c6
--- /dev/null
+++ b/lib/erl_interface/test/erl_global_SUITE.erl
@@ -0,0 +1,133 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(erl_global_SUITE).
+
+-include("test_server.hrl").
+-include("erl_global_SUITE_data/erl_global_test_cases.hrl").
+
+-export([all/1,init_per_testcase/2,fin_per_testcase/2,
+ erl_global_registration/1, erl_global_whereis/1, erl_global_names/1]).
+
+-import(runner, [get_term/1,send_term/2]).
+
+-define(GLOBAL_NAME, global_register_node_test).
+
+all(suite) ->
+ [erl_global_registration, erl_global_whereis, erl_global_names].
+
+init_per_testcase(_Case, Config) ->
+ Dog = ?t:timetrap(?t:minutes(0.25)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+erl_global_registration(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0),
+
+ ?line ok = erl_global_register(P, Fd, ?GLOBAL_NAME),
+ ?line ok = erl_global_unregister(P, Fd, ?GLOBAL_NAME),
+
+ ?line 0 = erl_close_connection(P,Fd),
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+erl_global_whereis(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0),
+
+ ?line Self = self(),
+ ?line yes = global:register_name(?GLOBAL_NAME, Self),
+ ?line Self = erl_global_whereis(P, Fd, ?GLOBAL_NAME),
+ ?line global:unregister_name(?GLOBAL_NAME),
+ ?line 0 = erl_close_connection(P, Fd),
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+erl_global_names(Config) when is_list(Config) ->
+ ?line P = runner:start(?interpret),
+ ?line {ok, Fd} = erl_connect(P, node(), 42, erlang:get_cookie(), 0),
+
+ ?line Self = self(),
+ ?line global:register_name(?GLOBAL_NAME, Self),
+ ?line {Names1, _N1} = erl_global_names(P, Fd),
+ ?line true = lists:member(atom_to_list(?GLOBAL_NAME), Names1),
+ ?line global:unregister_name(?GLOBAL_NAME),
+ ?line {Names2, _N2} = erl_global_names(P, Fd),
+ ?line false = lists:member(atom_to_list(?GLOBAL_NAME), Names2),
+ ?line 0 = erl_close_connection(P, Fd),
+ ?line runner:send_eot(P),
+ ?line runner:recv_eot(P),
+ ok.
+
+%%% Interface functions for erl_interface functions.
+
+erl_connect(P, Node, Num, Cookie, Creation) ->
+ send_command(P, erl_connect, [Num, Node, Cookie, Creation]),
+ case get_term(P) of
+ {term,{Fd,_}} when Fd >= 0 -> {ok,Fd};
+ {term,{-1,Errno}} -> {error,Errno}
+ end.
+
+erl_close_connection(P, FD) ->
+ send_command(P, erl_close_connection, [FD]),
+ case get_term(P) of
+ {term,Int} when is_integer(Int) -> Int
+ end.
+
+erl_global_register(P, Fd, Name) ->
+ send_command(P, erl_global_register, [Fd,Name]),
+ get_send_result(P).
+
+erl_global_whereis(P, Fd, Name) ->
+ send_command(P, erl_global_whereis, [Fd,Name]),
+ case get_term(P) of
+ {term, What} ->
+ What
+ end.
+
+erl_global_names(P, Fd) ->
+ send_command(P, erl_global_names, [Fd]),
+ case get_term(P) of
+ {term, What} ->
+ What
+ end.
+
+erl_global_unregister(P, Fd, Name) ->
+ send_command(P, erl_global_unregister, [Fd,Name]),
+ get_send_result(P).
+
+get_send_result(P) ->
+ case get_term(P) of
+ {term,{1,_}} -> ok;
+ {term,{0, 0}} -> ok;
+ {term,{-1, Errno}} -> {error,Errno};
+ {term,{_,_}}->
+ ?t:fail(bad_return_value)
+ end.
+
+send_command(P, Name, Args) ->
+ runner:send_term(P, {Name,list_to_tuple(Args)}).
diff --git a/lib/erl_interface/test/erl_global_SUITE_data/Makefile.first b/lib/erl_interface/test/erl_global_SUITE_data/Makefile.first
new file mode 100644
index 0000000000..8e3fcb924e
--- /dev/null
+++ b/lib/erl_interface/test/erl_global_SUITE_data/Makefile.first
@@ -0,0 +1,21 @@
+#
+# %CopyrightBegin%
+#
+# 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%
+#
+
+erl_global_test_decl.c: erl_global_test.c
+ erl -noinput -pa ../all_SUITE_data -s init_tc run erl_global_test -s erlang halt
diff --git a/lib/erl_interface/test/erl_global_SUITE_data/Makefile.src b/lib/erl_interface/test/erl_global_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..ef846bc440
--- /dev/null
+++ b/lib/erl_interface/test/erl_global_SUITE_data/Makefile.src
@@ -0,0 +1,41 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2000-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_interface_mk_include@@[email protected]
+
+CC0 = @CC@
+CC = ..@DS@all_SUITE_data@DS@gccifier@exe@ -CC"$(CC0)"
+LD = @LD@
+LIBPATH = @erl_interface_libpath@
+LIBERL = $(LIBPATH)/@erl_interface_lib@
+LIBEI = $(LIBPATH)/@erl_interface_eilib@
+LIBFLAGS = ../all_SUITE_data/runner@obj@ \
+ $(LIBERL) $(LIBEI) @LIBS@ @erl_interface_sock_libs@ \
+ @erl_interface_threadlib@
+CFLAGS = @EI_CFLAGS@ $(THR_DEFS) -I@erl_interface_include@ -I../all_SUITE_data
+OBJS = erl_global_test@obj@ erl_global_test_decl@obj@
+
+all: erl_global_test@exe@
+
+erl_global_test@exe@: $(OBJS) $(LIBERL) $(LIBEI)
+ $(LD) @CROSSLDFLAGS@ -o $@ $(OBJS) $(LIBFLAGS)
+
+clean:
+ $(RM) $(OBJS)
+ $(RM) erl_global_test@exe@
diff --git a/lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c b/lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c
new file mode 100644
index 0000000000..dc0d8a0091
--- /dev/null
+++ b/lib/erl_interface/test/erl_global_SUITE_data/erl_global_test.c
@@ -0,0 +1,263 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2000-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: Tests the functions in erl_global.c.
+ *
+ * See the erl_global_SUITE.erl file for a "table of contents".
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "runner.h"
+
+static void cmd_erl_connect(ETERM* args);
+static void cmd_erl_global_register(ETERM *args);
+static void cmd_erl_global_whereis(ETERM *args);
+static void cmd_erl_global_names(ETERM *args);
+static void cmd_erl_global_unregister(ETERM *args);
+static void cmd_erl_close_connection(ETERM *args);
+
+static void send_errno_result(int value);
+
+static struct {
+ char* name;
+ int num_args; /* Number of arguments. */
+ void (*func)(ETERM* args);
+} commands[] = {
+ "erl_connect", 4, cmd_erl_connect,
+ "erl_close_connection", 1, cmd_erl_close_connection,
+ "erl_global_register", 2, cmd_erl_global_register,
+ "erl_global_whereis", 2, cmd_erl_global_whereis,
+ "erl_global_names", 1, cmd_erl_global_names,
+ "erl_global_unregister", 2, cmd_erl_global_unregister,
+};
+
+
+/*
+ * Sends a list contaning all data types to the Erlang side.
+ */
+
+TESTCASE(interpret)
+{
+ ETERM* term;
+
+ erl_init(NULL, 0);
+
+ outer_loop:
+
+ term = get_term();
+
+ if (term == NULL) {
+ report(1);
+ return;
+ } else {
+ ETERM* Func;
+ ETERM* Args;
+ int i;
+
+ if (!ERL_IS_TUPLE(term) || ERL_TUPLE_SIZE(term) != 2) {
+ fail("term should be a tuple of size 2");
+ }
+
+ Func = erl_element(1, term);
+ if (!ERL_IS_ATOM(Func)) {
+ fail("function name should be an atom");
+ }
+ Args = erl_element(2, term);
+ if (!ERL_IS_TUPLE(Args)) {
+ fail("function arguments should be a tuple");
+ }
+ erl_free_term(term);
+ for (i = 0; i < sizeof(commands)/sizeof(commands[0]); i++) {
+ int n = strlen(commands[i].name);
+ if (ERL_ATOM_SIZE(Func) != n) {
+ continue;
+ }
+ if (memcmp(ERL_ATOM_PTR(Func), commands[i].name, n) == 0) {
+ erl_free_term(Func);
+ if (ERL_TUPLE_SIZE(Args) != commands[i].num_args) {
+ fail("wrong number of arguments");
+ }
+ commands[i].func(Args);
+ erl_free_term(Args);
+ goto outer_loop;
+ }
+ }
+ fail("bad command");
+ }
+}
+
+#define VERIFY_TYPE(Test, Term) \
+if (!Test(Term)) { \
+ fail("wrong type for " #Term); \
+} else { \
+}
+
+static void
+cmd_erl_connect(ETERM* args)
+{
+ ETERM* number;
+ ETERM* node;
+ ETERM* cookie;
+
+ int res;
+ char buffer[256];
+
+ number = ERL_TUPLE_ELEMENT(args, 0);
+ VERIFY_TYPE(ERL_IS_INTEGER, number);
+ node = ERL_TUPLE_ELEMENT(args, 1);
+ VERIFY_TYPE(ERL_IS_ATOM, node);
+ cookie = ERL_TUPLE_ELEMENT(args, 2);
+ VERIFY_TYPE(ERL_IS_ATOM, cookie);
+
+ if (ERL_ATOM_SIZE(cookie) == 0) {
+ res = erl_connect_init(ERL_INT_VALUE(number), 0, 0);
+ } else {
+ memcpy(buffer, ERL_ATOM_PTR(cookie), ERL_ATOM_SIZE(cookie));
+ buffer[ERL_ATOM_SIZE(cookie)] = '\0';
+ res = erl_connect_init(ERL_INT_VALUE(number), buffer, 0);
+ }
+
+ if(!res) {
+ send_errno_result(res);
+ return;
+ }
+
+ memcpy(buffer, ERL_ATOM_PTR(node), ERL_ATOM_SIZE(node));
+ buffer[ERL_ATOM_SIZE(node)] = '\0';
+ send_errno_result(erl_connect(buffer));
+}
+
+static void
+cmd_erl_close_connection(ETERM* args)
+{
+ ETERM* number;
+ ETERM* res;
+
+ number = ERL_TUPLE_ELEMENT(args, 0);
+ VERIFY_TYPE(ERL_IS_INTEGER, number);
+ res = erl_mk_int(erl_close_connection(ERL_INT_VALUE(number)));
+ send_term(res);
+ erl_free_term(res);
+}
+
+static void
+cmd_erl_global_register(ETERM* args)
+{
+ ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0);
+ ETERM* name = ERL_TUPLE_ELEMENT(args, 1);
+ ETERM* pid = erl_mk_pid(erl_thisnodename(), 14, 0, 0);
+
+ char buffer[256];
+
+ VERIFY_TYPE(ERL_IS_INTEGER, fd_term);
+ VERIFY_TYPE(ERL_IS_ATOM, name);
+
+ memcpy(buffer, ERL_ATOM_PTR(name), ERL_ATOM_SIZE(name));
+ buffer[ERL_ATOM_SIZE(name)] = '\0';
+
+ send_errno_result(erl_global_register(ERL_INT_VALUE(fd_term), buffer, pid));
+ erl_free_term(pid);
+}
+
+static void
+cmd_erl_global_whereis(ETERM* args)
+{
+ ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0);
+ ETERM* name = ERL_TUPLE_ELEMENT(args, 1);
+ ETERM* pid = NULL;
+
+ char buffer[256];
+
+ VERIFY_TYPE(ERL_IS_INTEGER, fd_term);
+ VERIFY_TYPE(ERL_IS_ATOM, name);
+
+ memcpy(buffer, ERL_ATOM_PTR(name), ERL_ATOM_SIZE(name));
+ buffer[ERL_ATOM_SIZE(name)] = '\0';
+
+ pid = erl_global_whereis(ERL_INT_VALUE(fd_term), buffer, NULL);
+ send_term(pid);
+ erl_free_term(pid);
+}
+
+static void
+cmd_erl_global_names(ETERM* args)
+{
+ ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0);
+
+ ETERM* res_array[2], *res_tuple, *name;
+ char** names = NULL;
+ int count = 0, i;
+
+ VERIFY_TYPE(ERL_IS_INTEGER, fd_term);
+
+ names = erl_global_names(ERL_INT_VALUE(fd_term), &count);
+
+ res_array[0] = erl_mk_empty_list();
+ for(i=0; i<count; i++) {
+ name = erl_mk_string(names[i]);
+ res_array[0] = erl_cons(name, res_array[0]);
+ }
+
+ free(names);
+
+ res_array[1] = erl_mk_int(count);
+ res_tuple = erl_mk_tuple(res_array, 2);
+
+ send_term(res_tuple);
+
+ erl_free_compound(res_array[0]);
+ erl_free_term(res_array[1]);
+ erl_free_term(res_tuple);
+}
+
+static void
+cmd_erl_global_unregister(ETERM* args)
+{
+ ETERM* fd_term = ERL_TUPLE_ELEMENT(args, 0);
+ ETERM* name = ERL_TUPLE_ELEMENT(args, 1);
+
+ char buffer[256];
+
+ VERIFY_TYPE(ERL_IS_INTEGER, fd_term);
+ VERIFY_TYPE(ERL_IS_ATOM, name);
+
+ memcpy(buffer, ERL_ATOM_PTR(name), ERL_ATOM_SIZE(name));
+ buffer[ERL_ATOM_SIZE(name)] = '\0';
+
+ send_errno_result(erl_global_unregister(ERL_INT_VALUE(fd_term), buffer));
+}
+
+static void
+send_errno_result(int value)
+{
+ ETERM* res_array[2];
+ ETERM* res_tuple;
+
+ res_array[0] = erl_mk_int(value);
+ res_array[1] = erl_mk_int(erl_errno);
+ res_tuple = erl_mk_tuple(res_array, 2);
+ send_term(res_tuple);
+ erl_free_term(res_array[0]);
+ erl_free_term(res_array[1]);
+ erl_free_term(res_tuple);
+}
diff --git a/lib/erl_interface/test/port_call_SUITE.erl b/lib/erl_interface/test/port_call_SUITE.erl
index 895e29ad2e..2c550e4c0c 100644
--- a/lib/erl_interface/test/port_call_SUITE.erl
+++ b/lib/erl_interface/test/port_call_SUITE.erl
@@ -42,6 +42,8 @@ all(suite) ->
basic(suite) -> [];
basic(Config) when is_list(Config) ->
case os:type() of
+ {unix, linux} ->
+ do_basic(Config);
{unix, sunos} ->
do_basic(Config);
{win32,_} ->
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index fc80dde5b5..309c118107 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -1867,6 +1867,8 @@ type(erts_debug, flat_size, 1, Xs) ->
strict(arg_types(erts_debug, flat_size, 1), Xs, fun (_) -> t_integer() end);
type(erts_debug, get_internal_state, 1, _) ->
t_any();
+type(erts_debug, instructions, 0, _) ->
+ t_list(t_list(t_byte()));
type(erts_debug, lock_counters, 1, Xs) ->
strict(arg_types(erts_debug, lock_counters, 1), Xs,
fun ([Arg]) ->
@@ -4093,6 +4095,8 @@ arg_types(erts_debug, flat_size, 1) ->
[t_any()];
arg_types(erts_debug, get_internal_state, 1) ->
[t_any()];
+arg_types(erts_debug, instructions, 0) ->
+ [];
arg_types(erts_debug, lock_counters, 1) ->
[t_sup([t_atom(enabled),
t_atom(info),
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index ec272379bb..daf7b77527 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1999</year><year>2010</year>
+ <year>1999</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -72,10 +72,10 @@
{verify_fun, {fun(), term()}} |
{fail_if_no_peer_cert, boolean()}
{depth, integer()} |
- {cert, der_bin()}| {certfile, path()} |
- {key, der_bin()} | {keyfile, path()} | {password, string()} |
- {cacerts, [der_bin()]} | {cacertfile, path()} |
- |{dh, der_bin()} | {dhfile, path()} | {ciphers, ciphers()} |
+ {cert, der_encoded()}| {certfile, path()} |
+ {key, der_encoded()} | {keyfile, path()} | {password, string()} |
+ {cacerts, [der_encoded()]} | {cacertfile, path()} |
+ |{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} |
{ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()}
</c></p>
@@ -95,7 +95,7 @@
<p><c>path() = string() - representing a file path.</c></p>
- <p><c>der_bin() = binary() -Asn1 DER encoded entity as an erlang binary.</c></p>
+ <p><c>der_encoded() = binary() -Asn1 DER encoded entity as an erlang binary.</c></p>
<p><c>host() = hostname() | ipaddress()</c></p>
@@ -136,14 +136,14 @@
<taglist>
- <tag>{cert, der_bin()}</tag>
+ <tag>{cert, der_encoded()}</tag>
<item> The DER encoded users certificate. If this option
is supplied it will override the certfile option.</item>
<tag>{certfile, path()}</tag>
<item>Path to a file containing the user's certificate.</item>
- <tag>{key, der_bin()}</tag>
+ <tag>{key, der_encoded()}</tag>
<item> The DER encoded users private key. If this option
is supplied it will override the keyfile option.</item>
@@ -158,7 +158,7 @@
Only used if the private keyfile is password protected.
</item>
- <tag>{cacerts, [der_bin()]}</tag>
+ <tag>{cacerts, [der_encoded()]}</tag>
<item> The DER encoded trusted certificates. If this option
is supplied it will override the cacertfile option.</item>
@@ -301,7 +301,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
<taglist>
- <tag>{dh, der_bin()}</tag>
+ <tag>{dh, der_encoded()}</tag>
<item>The DER encoded Diffie Hellman parameters. If this option
is supplied it will override the dhfile option.
</item>
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 7e5929d708..0e108c430f 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -49,6 +49,27 @@
inet_ssl, %% inet options for internal ssl socket
cb %% Callback info
}).
+-type option() :: socketoption() | ssloption() | transportoption().
+-type socketoption() :: [{property(), term()}]. %% See gen_tcp and inet
+-type property() :: atom().
+
+-type ssloption() :: {verify, verify_type()} |
+ {verify_fun, {fun(), InitialUserState::term()}} |
+ {fail_if_no_peer_cert, boolean()} | {depth, integer()} |
+ {cert, der_encoded()} | {certfile, path()} | {key, der_encoded()} |
+ {keyfile, path()} | {password, string()} | {cacerts, [der_encoded()]} |
+ {cacertfile, path()} | {dh, der_encoded()} | {dhfile, path()} |
+ {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} |
+ {reuse_session, fun()}.
+
+-type verify_type() :: verify_none | verify_peer.
+-type path() :: string().
+-type ciphers() :: [erl_cipher_suite()] |
+ string(). % (according to old API)
+-type ssl_imp() :: new | old.
+
+-type transportoption() :: {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}.
+
%%--------------------------------------------------------------------
-spec start() -> ok.
@@ -77,8 +98,8 @@ stop() ->
application:stop(ssl).
%%--------------------------------------------------------------------
--spec connect(host() | port(), list()) -> {ok, #sslsocket{}}.
--spec connect(host() | port(), list() | port_num(), timeout() | list()) -> {ok, #sslsocket{}}.
+-spec connect(host() | port(), [option()]) -> {ok, #sslsocket{}}.
+-spec connect(host() | port(), [option()] | port_num(), timeout() | list()) -> {ok, #sslsocket{}}.
-spec connect(host() | port(), port_num(), list(), timeout()) -> {ok, #sslsocket{}}.
%%
@@ -126,7 +147,7 @@ connect(Host, Port, Options0, Timeout) ->
end.
%%--------------------------------------------------------------------
--spec listen(port_num(), list()) ->{ok, #sslsocket{}} | {error, reason()}.
+-spec listen(port_num(), [option()]) ->{ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Creates a ssl listen socket.
@@ -189,9 +210,10 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) ->
ssl_broker:transport_accept(Pid, ListenSocket, Timeout).
%%--------------------------------------------------------------------
--spec ssl_accept(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}.
--spec ssl_accept(#sslsocket{}, list() | timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
--spec ssl_accept(port(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
+-spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}.
+-spec ssl_accept(#sslsocket{} | port(), timeout()| [option()]) ->
+ ok | {ok, #sslsocket{}} | {error, reason()}.
+-spec ssl_accept(port(), [option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Performs accept on a ssl listen socket. e.i. performs
%% ssl handshake.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 675e5e44bd..489895cf29 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -70,7 +70,6 @@
%% {{md5_hash, sha_hash}, {prev_md5, prev_sha}} (binary())
tls_handshake_hashes, % see above
tls_cipher_texts, % list() received but not deciphered yet
- own_cert, % binary() | undefined
session, % #session{} from ssl_handshake.hrl
session_cache, %
session_cache_cb, %
@@ -307,7 +306,6 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options,
{ok, Ref, CacheRef, OwnCert, Key, DHParams} ->
Session = State0#state.session,
State = State0#state{tls_handshake_hashes = Hashes0,
- own_cert = OwnCert,
session = Session#session{own_certificate = OwnCert},
cert_db_ref = Ref,
session_cache = CacheRef,
@@ -334,12 +332,10 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options,
%%--------------------------------------------------------------------
hello(start, #state{host = Host, port = Port, role = client,
ssl_options = SslOpts,
- own_cert = Cert,
+ session = #session{own_certificate = Cert} = Session0,
transport_cb = Transport, socket = Socket,
connection_states = ConnectionStates,
- renegotiation = {Renegotiation, _}}
- = State0) ->
-
+ renegotiation = {Renegotiation, _}} = State0) ->
Hello = ssl_handshake:client_hello(Host, Port,
ConnectionStates,
SslOpts, Renegotiation, Cert),
@@ -351,13 +347,13 @@ hello(start, #state{host = Host, port = Port, role = client,
Transport:send(Socket, BinMsg),
State1 = State0#state{connection_states = CS2,
negotiated_version = Version, %% Requested version
- session =
- #session{session_id = Hello#client_hello.session_id,
- is_resumable = false},
+ session =
+ Session0#session{session_id = Hello#client_hello.session_id,
+ is_resumable = false},
tls_handshake_hashes = Hashes1},
{Record, State} = next_record(State1),
next_state(hello, Record, State);
-
+
hello(start, #state{role = server} = State0) ->
{Record, State} = next_record(State0),
next_state(hello, Record, State);
@@ -374,7 +370,6 @@ hello(#server_hello{cipher_suite = CipherSuite,
negotiated_version = ReqVersion,
renegotiation = {Renegotiation, _},
ssl_options = SslOptions} = State0) ->
-
case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
{Version, NewId, ConnectionStates} ->
{KeyAlgorithm, _, _} =
@@ -400,13 +395,11 @@ hello(#server_hello{cipher_suite = CipherSuite,
hello(Hello = #client_hello{client_version = ClientVersion},
State = #state{connection_states = ConnectionStates0,
- port = Port, session = Session0,
+ port = Port, session = #session{own_certificate = Cert} = Session0,
renegotiation = {Renegotiation, _},
session_cache = Cache,
session_cache_cb = CacheCb,
- ssl_options = SslOpts,
- own_cert = Cert}) ->
-
+ ssl_options = SslOpts}) ->
case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
{Version, {Type, Session}, ConnectionStates} ->
@@ -540,7 +533,7 @@ certify(#server_hello_done{},
connection_states = ConnectionStates0,
negotiated_version = Version,
premaster_secret = undefined,
- role = client} = State0) ->
+ role = client} = State0) ->
case ssl_handshake:master_secret(Version, Session,
ConnectionStates0, client) of
{MasterSecret, ConnectionStates1} ->
@@ -617,7 +610,6 @@ certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPubl
diffie_hellman_params = #'DHParameter'{prime = P,
base = G},
diffie_hellman_keys = {_, ServerDhPrivateKey}} = State0) ->
-
case dh_master_secret(crypto:mpint(P), crypto:mpint(G), ClientPublicDhKey, ServerDhPrivateKey, State0) of
#state{} = State1 ->
{Record, State} = next_record(State1),
@@ -660,8 +652,7 @@ cipher(#finished{verify_data = Data} = Finished,
role = Role,
session = #session{master_secret = MasterSecret}
= Session0,
- tls_handshake_hashes = Hashes0} = State) ->
-
+ tls_handshake_hashes = Hashes0} = State) ->
case ssl_handshake:verify_connection(Version, Finished,
opposite_role(Role),
MasterSecret, Hashes0) of
@@ -682,14 +673,13 @@ cipher(Msg, State) ->
%%--------------------------------------------------------------------
connection(#hello_request{}, #state{host = Host, port = Port,
socket = Socket,
- own_cert = Cert,
+ session = #session{own_certificate = Cert},
ssl_options = SslOpts,
negotiated_version = Version,
transport_cb = Transport,
connection_states = ConnectionStates0,
renegotiation = {Renegotiation, _},
tls_handshake_hashes = Hashes0} = State0) ->
-
Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0,
SslOpts, Renegotiation, Cert),
@@ -1096,6 +1086,7 @@ init_private_key({rsa, PrivateKey}, _, _,_) ->
init_private_key({dsa, PrivateKey},_,_,_) ->
public_key:der_decode('DSAPrivateKey', PrivateKey).
+-spec(handle_file_error/6 :: (_,_,_,_,_,_) -> no_return()).
handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) ->
file_error(Line, Error, Reason, File, Throw, Stack);
handle_file_error(Line, Error, Reason, File, Throw, Stack) ->
@@ -1161,7 +1152,7 @@ certify_client(#state{client_certificate_requested = true, role = client,
transport_cb = Transport,
negotiated_version = Version,
cert_db_ref = CertDbRef,
- own_cert = OwnCert,
+ session = #session{own_certificate = OwnCert},
socket = Socket,
tls_handshake_hashes = Hashes0} = State) ->
Certificate = ssl_handshake:certificate(OwnCert, CertDbRef, client),
@@ -1177,10 +1168,10 @@ verify_client_cert(#state{client_certificate_requested = true, role = client,
connection_states = ConnectionStates0,
transport_cb = Transport,
negotiated_version = Version,
- own_cert = OwnCert,
socket = Socket,
private_key = PrivateKey,
- session = #session{master_secret = MasterSecret},
+ session = #session{master_secret = MasterSecret,
+ own_certificate = OwnCert},
tls_handshake_hashes = Hashes0} = State) ->
case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret,
@@ -1346,7 +1337,7 @@ certify_server(#state{transport_cb = Transport,
connection_states = ConnectionStates,
tls_handshake_hashes = Hashes,
cert_db_ref = CertDbRef,
- own_cert = OwnCert} = State) ->
+ session = #session{own_certificate = OwnCert}} = State) ->
case ssl_handshake:certificate(OwnCert, CertDbRef, server) of
CertMsg = #certificate{} ->
{BinCertMsg, NewConnectionStates, NewHashes} =
@@ -1373,7 +1364,6 @@ key_exchange(#state{role = server, key_algorithm = Algo,
when Algo == dhe_dss;
Algo == dhe_rsa;
Algo == dh_anon ->
-
Keys = crypto:dh_generate_key([crypto:mpint(P), crypto:mpint(G)]),
ConnectionState =
ssl_record:pending_connection_state(ConnectionStates0, read),
@@ -1925,14 +1915,22 @@ next_state_connection(StateName, #state{send_queue = Queue0,
next_state_is_connection(State)
end.
+%% In next_state_is_connection/1: clear tls_handshake_hashes,
+%% premaster_secret and public_key_info (only needed during handshake)
+%% to reduce memory foot print of a connection.
next_state_is_connection(State =
#state{recv_during_renegotiation = true, socket_options =
#socket_options{active = false}}) ->
- passive_receive(State#state{recv_during_renegotiation = false}, connection);
+ passive_receive(State#state{recv_during_renegotiation = false,
+ premaster_secret = undefined,
+ public_key_info = undefined,
+ tls_handshake_hashes = {<<>>, <<>>}}, connection);
next_state_is_connection(State0) ->
{Record, State} = next_record_if_active(State0),
- next_state(connection, Record, State).
+ next_state(connection, Record, State#state{premaster_secret = undefined,
+ public_key_info = undefined,
+ tls_handshake_hashes = {<<>>, <<>>}}).
register_session(_, _, _, #session{is_resumable = true} = Session) ->
Session; %% Already registered
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 43a85c2d9d..715941e3ad 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -19,7 +19,6 @@
%%
-
-ifndef(ssl_internal).
-define(ssl_internal, true).
diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl
index ebef998ee1..a14a72ac6d 100644
--- a/lib/stdlib/src/base64.erl
+++ b/lib/stdlib/src/base64.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -114,7 +114,7 @@ decode(List) when is_list(List) ->
mime_decode(Bin) when is_binary(Bin) ->
mime_decode_binary(<<>>, Bin);
mime_decode(List) when is_list(List) ->
- list_to_binary(mime_decode_l(List)).
+ mime_decode(list_to_binary(List)).
-spec decode_l(string()) -> string().
@@ -125,7 +125,7 @@ decode_l(List) ->
-spec mime_decode_l(string()) -> string().
mime_decode_l(List) ->
- L = strip_illegal(List, []),
+ L = strip_illegal(List, [], 0),
decode(L, []).
%%-------------------------------------------------------------------------
@@ -198,6 +198,9 @@ decode_binary(Result, <<>>) ->
true = is_binary(Result),
Result.
+%% Skipping pad character if not at end of string. Also liberal about
+%% excess padding and skipping of other illegal (non-base64 alphabet)
+%% characters. See section 3.3 of RFC4648
mime_decode_binary(Result, <<0:8,T/bits>>) ->
mime_decode_binary(Result, T);
mime_decode_binary(Result0, <<C:8,T/bits>>) ->
@@ -205,15 +208,27 @@ mime_decode_binary(Result0, <<C:8,T/bits>>) ->
Bits when is_integer(Bits) ->
mime_decode_binary(<<Result0/bits,Bits:6>>, T);
eq ->
- case tail_contains_equal(T) of
- true ->
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- false ->
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
+ case tail_contains_more(T, false) of
+ {<<>>, Eq} ->
+ %% No more valid data.
+ case bit_size(Result0) rem 8 of
+ 0 ->
+ %% '====' is not uncommon.
+ Result0;
+ 4 when Eq ->
+ %% enforce at least one more '=' only ignoring illegals and spacing
+ Split = byte_size(Result0) - 1,
+ <<Result:Split/bytes,_:4>> = Result0,
+ Result;
+ 2 ->
+ %% remove 2 bits
+ Split = byte_size(Result0) - 1,
+ <<Result:Split/bytes,_:2>> = Result0,
+ Result
+ end;
+ {More, _} ->
+ %% More valid data, skip the eq as invalid
+ mime_decode_binary(Result0, More)
end;
_ ->
mime_decode_binary(Result0, T)
@@ -262,31 +277,63 @@ strip_ws(<<$\s,T/binary>>) ->
strip_ws(T);
strip_ws(T) -> T.
-strip_illegal([0|Cs], A) ->
- strip_illegal(Cs, A);
-strip_illegal([C|Cs], A) ->
+%% Skipping pad character if not at end of string. Also liberal about
+%% excess padding and skipping of other illegal (non-base64 alphabet)
+%% characters. See section 3.3 of RFC4648
+strip_illegal([], A, _Cnt) ->
+ A;
+strip_illegal([0|Cs], A, Cnt) ->
+ strip_illegal(Cs, A, Cnt);
+strip_illegal([C|Cs], A, Cnt) ->
case element(C, ?DECODE_MAP) of
- bad -> strip_illegal(Cs, A);
- ws -> strip_illegal(Cs, A);
- eq -> strip_illegal_end(Cs, [$=|A]);
- _ -> strip_illegal(Cs, [C|A])
- end;
-strip_illegal([], A) -> A.
+ bad ->
+ strip_illegal(Cs, A, Cnt);
+ ws ->
+ strip_illegal(Cs, A, Cnt);
+ eq ->
+ case {tail_contains_more(Cs, false), Cnt rem 4} of
+ {{[], _}, 0} ->
+ A; %% Ignore extra =
+ {{[], true}, 2} ->
+ [$=|[$=|A]]; %% 'XX=='
+ {{[], _}, 3} ->
+ [$=|A]; %% 'XXX='
+ {{[H|T], _}, _} ->
+ %% more data, skip equals
+ strip_illegal(T, [H|A], Cnt+1)
+ end;
+ _ ->
+ strip_illegal(Cs, [C|A], Cnt+1)
+ end.
-strip_illegal_end([0|Cs], A) ->
- strip_illegal_end(Cs, A);
-strip_illegal_end([C|Cs], A) ->
+%% Search the tail for more valid data and remember if we saw
+%% another equals along the way.
+tail_contains_more([], Eq) ->
+ {[], Eq};
+tail_contains_more(<<>>, Eq) ->
+ {<<>>, Eq};
+tail_contains_more([C|T]=More, Eq) ->
case element(C, ?DECODE_MAP) of
- bad -> strip_illegal(Cs, A);
- ws -> strip_illegal(Cs, A);
- eq -> [C|A];
- _ -> strip_illegal(Cs, [C|A])
+ bad ->
+ tail_contains_more(T, Eq);
+ ws ->
+ tail_contains_more(T, Eq);
+ eq ->
+ tail_contains_more(T, true);
+ _ ->
+ {More, Eq}
end;
-strip_illegal_end([], A) -> A.
-
-tail_contains_equal(<<$=,_/binary>>) -> true;
-tail_contains_equal(<<_,T/binary>>) -> tail_contains_equal(T);
-tail_contains_equal(<<>>) -> false.
+tail_contains_more(<<C:8,T/bits>> =More, Eq) ->
+ case element(C, ?DECODE_MAP) of
+ bad ->
+ tail_contains_more(T, Eq);
+ ws ->
+ tail_contains_more(T, Eq);
+ eq ->
+ tail_contains_more(T, true);
+ _ ->
+ {More, Eq}
+ end.
%% accessors
b64e(X) ->
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index d04d8f191f..235ea939a8 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -42,31 +42,31 @@
-spec help() -> 'ok'.
help() ->
- format("bt(Pid) -- stack backtrace for a process\n"
- "c(File) -- compile and load code in <File>\n"
- "cd(Dir) -- change working directory\n"
- "flush() -- flush any messages sent to the shell\n"
- "help() -- help info\n"
- "i() -- information about the system\n"
- "ni() -- information about the networked system\n"
- "i(X,Y,Z) -- information about pid <X,Y,Z>\n"
- "l(Module) -- load or reload module\n"
- "lc([File]) -- compile a list of Erlang modules\n"
- "ls() -- list files in the current directory\n"
- "ls(Dir) -- list files in directory <Dir>\n"
- "m() -- which modules are loaded\n"
- "m(Mod) -- information about module <Mod>\n"
- "memory() -- memory allocation information\n"
- "memory(T) -- memory allocation information of type <T>\n"
- "nc(File) -- compile and load code in <File> on all nodes\n"
- "nl(Module) -- load module on all nodes\n"
- "pid(X,Y,Z) -- convert X,Y,Z to a Pid\n"
- "pwd() -- print working directory\n"
- "q() -- quit - shorthand for init:stop()\n"
- "regs() -- information about registered processes\n"
- "nregs() -- information about all registered processes\n"
- "xm(M) -- cross reference check a module\n"
- "y(File) -- generate a Yecc parser\n").
+ io:put_chars(<<"bt(Pid) -- stack backtrace for a process\n"
+ "c(File) -- compile and load code in <File>\n"
+ "cd(Dir) -- change working directory\n"
+ "flush() -- flush any messages sent to the shell\n"
+ "help() -- help info\n"
+ "i() -- information about the system\n"
+ "ni() -- information about the networked system\n"
+ "i(X,Y,Z) -- information about pid <X,Y,Z>\n"
+ "l(Module) -- load or reload module\n"
+ "lc([File]) -- compile a list of Erlang modules\n"
+ "ls() -- list files in the current directory\n"
+ "ls(Dir) -- list files in directory <Dir>\n"
+ "m() -- which modules are loaded\n"
+ "m(Mod) -- information about module <Mod>\n"
+ "memory() -- memory allocation information\n"
+ "memory(T) -- memory allocation information of type <T>\n"
+ "nc(File) -- compile and load code in <File> on all nodes\n"
+ "nl(Module) -- load module on all nodes\n"
+ "pid(X,Y,Z) -- convert X,Y,Z to a Pid\n"
+ "pwd() -- print working directory\n"
+ "q() -- quit - shorthand for init:stop()\n"
+ "regs() -- information about registered processes\n"
+ "nregs() -- information about all registered processes\n"
+ "xm(M) -- cross reference check a module\n"
+ "y(File) -- generate a Yecc parser\n">>).
%% c(FileName)
%% Compile a file/module.
diff --git a/lib/stdlib/src/erl_posix_msg.erl b/lib/stdlib/src/erl_posix_msg.erl
index fe981b23a7..909cc1d102 100644
--- a/lib/stdlib/src/erl_posix_msg.erl
+++ b/lib/stdlib/src/erl_posix_msg.erl
@@ -1,7 +1,7 @@
%%
%% %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
@@ -24,143 +24,146 @@
-spec message(atom()) -> string().
-message(e2big) -> "argument list too long";
-message(eacces) -> "permission denied";
-message(eaddrinuse) -> "address already in use";
-message(eaddrnotavail) -> "can't assign requested address";
-message(eadv) -> "advertise error";
-message(eafnosupport) -> "address family not supported by protocol family";
-message(eagain) -> "resource temporarily unavailable";
-message(ealign) -> "EALIGN";
-message(ealready) -> "operation already in progress";
-message(ebade) -> "bad exchange descriptor";
-message(ebadf) -> "bad file number";
-message(ebadfd) -> "file descriptor in bad state";
-message(ebadmsg) -> "not a data message";
-message(ebadr) -> "bad request descriptor";
-message(ebadrpc) -> "RPC structure is bad";
-message(ebadrqc) -> "bad request code";
-message(ebadslt) -> "invalid slot";
-message(ebfont) -> "bad font file format";
-message(ebusy) -> "file busy";
-message(echild) -> "no children";
-message(echrng) -> "channel number out of range";
-message(ecomm) -> "communication error on send";
-message(econnaborted) -> "software caused connection abort";
-message(econnrefused) -> "connection refused";
-message(econnreset) -> "connection reset by peer";
-message(edeadlk) -> "resource deadlock avoided";
-message(edeadlock) -> "resource deadlock avoided";
-message(edestaddrreq) -> "destination address required";
-message(edirty) -> "mounting a dirty fs w/o force";
-message(edom) -> "math argument out of range";
-message(edotdot) -> "cross mount point";
-message(edquot) -> "disk quota exceeded";
-message(eduppkg) -> "duplicate package name";
-message(eexist) -> "file already exists";
-message(efault) -> "bad address in system call argument";
-message(efbig) -> "file too large";
-message(ehostdown) -> "host is down";
-message(ehostunreach) -> "host is unreachable";
-message(eidrm) -> "identifier removed";
-message(einit) -> "initialization error";
-message(einprogress) -> "operation now in progress";
-message(eintr) -> "interrupted system call";
-message(einval) -> "invalid argument";
-message(eio) -> "I/O error";
-message(eisconn) -> "socket is already connected";
-message(eisdir) -> "illegal operation on a directory";
-message(eisnam) -> "is a name file";
-message(elbin) -> "ELBIN";
-message(el2hlt) -> "level 2 halted";
-message(el2nsync) -> "level 2 not synchronized";
-message(el3hlt) -> "level 3 halted";
-message(el3rst) -> "level 3 reset";
-message(elibacc) -> "can not access a needed shared library";
-message(elibbad) -> "accessing a corrupted shared library";
-message(elibexec) -> "can not exec a shared library directly";
-message(elibmax) ->
- "attempting to link in more shared libraries than system limit";
-message(elibscn) -> ".lib section in a.out corrupted";
-message(elnrng) -> "link number out of range";
-message(eloop) -> "too many levels of symbolic links";
-message(emfile) -> "too many open files";
-message(emlink) -> "too many links";
-message(emsgsize) -> "message too long";
-message(emultihop) -> "multihop attempted";
-message(enametoolong) -> "file name too long";
-message(enavail) -> "not available";
-message(enet) -> "ENET";
-message(enetdown) -> "network is down";
-message(enetreset) -> "network dropped connection on reset";
-message(enetunreach) -> "network is unreachable";
-message(enfile) -> "file table overflow";
-message(enoano) -> "anode table overflow";
-message(enobufs) -> "no buffer space available";
-message(enocsi) -> "no CSI structure available";
-message(enodata) -> "no data available";
-message(enodev) -> "no such device";
-message(enoent) -> "no such file or directory";
-message(enoexec) -> "exec format error";
-message(enolck) -> "no locks available";
-message(enolink) -> "link has be severed";
-message(enomem) -> "not enough memory";
-message(enomsg) -> "no message of desired type";
-message(enonet) -> "machine is not on the network";
-message(enopkg) -> "package not installed";
-message(enoprotoopt) -> "bad proocol option";
-message(enospc) -> "no space left on device";
-message(enosr) -> "out of stream resources or not a stream device";
-message(enosym) -> "unresolved symbol name";
-message(enosys) -> "function not implemented";
-message(enotblk) -> "block device required";
-message(enotconn) -> "socket is not connected";
-message(enotdir) -> "not a directory";
-message(enotempty) -> "directory not empty";
-message(enotnam) -> "not a name file";
-message(enotsock) -> "socket operation on non-socket";
-message(enotsup) -> "operation not supported";
-message(enotty) -> "inappropriate device for ioctl";
-message(enotuniq) -> "name not unique on network";
-message(enxio) -> "no such device or address";
-message(eopnotsupp) -> "operation not supported on socket";
-message(eperm) -> "not owner";
-message(epfnosupport) -> "protocol family not supported";
-message(epipe) -> "broken pipe";
-message(eproclim) -> "too many processes";
-message(eprocunavail) -> "bad procedure for program";
-message(eprogmismatch) -> "program version wrong";
-message(eprogunavail) -> "RPC program not available";
-message(eproto) -> "protocol error";
-message(eprotonosupport) -> "protocol not suppored";
-message(eprototype) -> "protocol wrong type for socket";
-message(erange) -> "math result unrepresentable";
-message(erefused) -> "EREFUSED";
-message(eremchg) -> "remote address changed";
-message(eremdev) -> "remote device";
-message(eremote) -> "pathname hit remote file system";
-message(eremoteio) -> "remote i/o error";
-message(eremoterelease) -> "EREMOTERELEASE";
-message(erofs) -> "read-only file system";
-message(erpcmismatch) -> "RPC version is wrong";
-message(erremote) -> "object is remote";
-message(eshutdown) -> "can't send after socket shutdown";
-message(esocktnosupport) -> "socket type not supported";
-message(espipe) -> "invalid seek";
-message(esrch) -> "no such process";
-message(esrmnt) -> "srmount error";
-message(estale) -> "stale remote file handle";
-message(esuccess) -> "Error 0";
-message(etime) -> "timer expired";
-message(etimedout) -> "connection timed out";
-message(etoomanyrefs) -> "too many references: can't splice";
-message(etxtbsy) -> "text file or pseudo-device busy";
-message(euclean) -> "structure needs cleaning";
-message(eunatch) -> "protocol driver not attached";
-message(eusers) -> "too many users";
-message(eversion) -> "version mismatch";
-message(ewouldblock) -> "operation would block";
-message(exdev) -> "cross-domain link";
-message(exfull) -> "message tables full";
-message(nxdomain) -> "non-existing domain";
-message(_) -> "unknown POSIX error".
+message(T) ->
+ binary_to_list(message_1(T)).
+
+message_1(e2big) -> <<"argument list too long">>;
+message_1(eacces) -> <<"permission denied">>;
+message_1(eaddrinuse) -> <<"address already in use">>;
+message_1(eaddrnotavail) -> <<"can't assign requested address">>;
+message_1(eadv) -> <<"advertise error">>;
+message_1(eafnosupport) -> <<"address family not supported by protocol family">>;
+message_1(eagain) -> <<"resource temporarily unavailable">>;
+message_1(ealign) -> <<"EALIGN">>;
+message_1(ealready) -> <<"operation already in progress">>;
+message_1(ebade) -> <<"bad exchange descriptor">>;
+message_1(ebadf) -> <<"bad file number">>;
+message_1(ebadfd) -> <<"file descriptor in bad state">>;
+message_1(ebadmsg) -> <<"not a data message">>;
+message_1(ebadr) -> <<"bad request descriptor">>;
+message_1(ebadrpc) -> <<"RPC structure is bad">>;
+message_1(ebadrqc) -> <<"bad request code">>;
+message_1(ebadslt) -> <<"invalid slot">>;
+message_1(ebfont) -> <<"bad font file format">>;
+message_1(ebusy) -> <<"file busy">>;
+message_1(echild) -> <<"no children">>;
+message_1(echrng) -> <<"channel number out of range">>;
+message_1(ecomm) -> <<"communication error on send">>;
+message_1(econnaborted) -> <<"software caused connection abort">>;
+message_1(econnrefused) -> <<"connection refused">>;
+message_1(econnreset) -> <<"connection reset by peer">>;
+message_1(edeadlk) -> <<"resource deadlock avoided">>;
+message_1(edeadlock) -> <<"resource deadlock avoided">>;
+message_1(edestaddrreq) -> <<"destination address required">>;
+message_1(edirty) -> <<"mounting a dirty fs w/o force">>;
+message_1(edom) -> <<"math argument out of range">>;
+message_1(edotdot) -> <<"cross mount point">>;
+message_1(edquot) -> <<"disk quota exceeded">>;
+message_1(eduppkg) -> <<"duplicate package name">>;
+message_1(eexist) -> <<"file already exists">>;
+message_1(efault) -> <<"bad address in system call argument">>;
+message_1(efbig) -> <<"file too large">>;
+message_1(ehostdown) -> <<"host is down">>;
+message_1(ehostunreach) -> <<"host is unreachable">>;
+message_1(eidrm) -> <<"identifier removed">>;
+message_1(einit) -> <<"initialization error">>;
+message_1(einprogress) -> <<"operation now in progress">>;
+message_1(eintr) -> <<"interrupted system call">>;
+message_1(einval) -> <<"invalid argument">>;
+message_1(eio) -> <<"I/O error">>;
+message_1(eisconn) -> <<"socket is already connected">>;
+message_1(eisdir) -> <<"illegal operation on a directory">>;
+message_1(eisnam) -> <<"is a name file">>;
+message_1(elbin) -> <<"ELBIN">>;
+message_1(el2hlt) -> <<"level 2 halted">>;
+message_1(el2nsync) -> <<"level 2 not synchronized">>;
+message_1(el3hlt) -> <<"level 3 halted">>;
+message_1(el3rst) -> <<"level 3 reset">>;
+message_1(elibacc) -> <<"can not access a needed shared library">>;
+message_1(elibbad) -> <<"accessing a corrupted shared library">>;
+message_1(elibexec) -> <<"can not exec a shared library directly">>;
+message_1(elibmax) ->
+ <<"attempting to link in more shared libraries than system limit">>;
+message_1(elibscn) -> <<".lib section in a.out corrupted">>;
+message_1(elnrng) -> <<"link number out of range">>;
+message_1(eloop) -> <<"too many levels of symbolic links">>;
+message_1(emfile) -> <<"too many open files">>;
+message_1(emlink) -> <<"too many links">>;
+message_1(emsgsize) -> <<"message too long">>;
+message_1(emultihop) -> <<"multihop attempted">>;
+message_1(enametoolong) -> <<"file name too long">>;
+message_1(enavail) -> <<"not available">>;
+message_1(enet) -> <<"ENET">>;
+message_1(enetdown) -> <<"network is down">>;
+message_1(enetreset) -> <<"network dropped connection on reset">>;
+message_1(enetunreach) -> <<"network is unreachable">>;
+message_1(enfile) -> <<"file table overflow">>;
+message_1(enoano) -> <<"anode table overflow">>;
+message_1(enobufs) -> <<"no buffer space available">>;
+message_1(enocsi) -> <<"no CSI structure available">>;
+message_1(enodata) -> <<"no data available">>;
+message_1(enodev) -> <<"no such device">>;
+message_1(enoent) -> <<"no such file or directory">>;
+message_1(enoexec) -> <<"exec format error">>;
+message_1(enolck) -> <<"no locks available">>;
+message_1(enolink) -> <<"link has be severed">>;
+message_1(enomem) -> <<"not enough memory">>;
+message_1(enomsg) -> <<"no message of desired type">>;
+message_1(enonet) -> <<"machine is not on the network">>;
+message_1(enopkg) -> <<"package not installed">>;
+message_1(enoprotoopt) -> <<"bad proocol option">>;
+message_1(enospc) -> <<"no space left on device">>;
+message_1(enosr) -> <<"out of stream resources or not a stream device">>;
+message_1(enosym) -> <<"unresolved symbol name">>;
+message_1(enosys) -> <<"function not implemented">>;
+message_1(enotblk) -> <<"block device required">>;
+message_1(enotconn) -> <<"socket is not connected">>;
+message_1(enotdir) -> <<"not a directory">>;
+message_1(enotempty) -> <<"directory not empty">>;
+message_1(enotnam) -> <<"not a name file">>;
+message_1(enotsock) -> <<"socket operation on non-socket">>;
+message_1(enotsup) -> <<"operation not supported">>;
+message_1(enotty) -> <<"inappropriate device for ioctl">>;
+message_1(enotuniq) -> <<"name not unique on network">>;
+message_1(enxio) -> <<"no such device or address">>;
+message_1(eopnotsupp) -> <<"operation not supported on socket">>;
+message_1(eperm) -> <<"not owner">>;
+message_1(epfnosupport) -> <<"protocol family not supported">>;
+message_1(epipe) -> <<"broken pipe">>;
+message_1(eproclim) -> <<"too many processes">>;
+message_1(eprocunavail) -> <<"bad procedure for program">>;
+message_1(eprogmismatch) -> <<"program version wrong">>;
+message_1(eprogunavail) -> <<"RPC program not available">>;
+message_1(eproto) -> <<"protocol error">>;
+message_1(eprotonosupport) -> <<"protocol not suppored">>;
+message_1(eprototype) -> <<"protocol wrong type for socket">>;
+message_1(erange) -> <<"math result unrepresentable">>;
+message_1(erefused) -> <<"EREFUSED">>;
+message_1(eremchg) -> <<"remote address changed">>;
+message_1(eremdev) -> <<"remote device">>;
+message_1(eremote) -> <<"pathname hit remote file system">>;
+message_1(eremoteio) -> <<"remote i/o error">>;
+message_1(eremoterelease) -> <<"EREMOTERELEASE">>;
+message_1(erofs) -> <<"read-only file system">>;
+message_1(erpcmismatch) -> <<"RPC version is wrong">>;
+message_1(erremote) -> <<"object is remote">>;
+message_1(eshutdown) -> <<"can't send after socket shutdown">>;
+message_1(esocktnosupport) -> <<"socket type not supported">>;
+message_1(espipe) -> <<"invalid seek">>;
+message_1(esrch) -> <<"no such process">>;
+message_1(esrmnt) -> <<"srmount error">>;
+message_1(estale) -> <<"stale remote file handle">>;
+message_1(esuccess) -> <<"Error 0">>;
+message_1(etime) -> <<"timer expired">>;
+message_1(etimedout) -> <<"connection timed out">>;
+message_1(etoomanyrefs) -> <<"too many references: can't splice">>;
+message_1(etxtbsy) -> <<"text file or pseudo-device busy">>;
+message_1(euclean) -> <<"structure needs cleaning">>;
+message_1(eunatch) -> <<"protocol driver not attached">>;
+message_1(eusers) -> <<"too many users">>;
+message_1(eversion) -> <<"version mismatch">>;
+message_1(ewouldblock) -> <<"operation would block">>;
+message_1(exdev) -> <<"cross-domain link">>;
+message_1(exfull) -> <<"message tables full">>;
+message_1(nxdomain) -> <<"non-existing domain">>;
+message_1(_) -> <<"unknown POSIX error">>.
diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl
index 44742063b3..d8bb2dfb60 100644
--- a/lib/stdlib/test/base64_SUITE.erl
+++ b/lib/stdlib/test/base64_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,6 @@
%%
-module(base64_SUITE).
--author('[email protected]').
-include("test_server.hrl").
-include("test_server_line.hrl").
@@ -29,7 +28,7 @@
%% Test cases must be exported.
-export([base64_encode/1, base64_decode/1, base64_otp_5635/1,
base64_otp_6279/1, big/1, illegal/1, mime_decode/1,
- roundtrip/1]).
+ mime_decode_to_string/1, roundtrip/1]).
init_per_testcase(_, Config) ->
Dog = test_server:timetrap(?t:minutes(2)),
@@ -50,7 +49,7 @@ all(doc) ->
all(suite) ->
[base64_encode, base64_decode, base64_otp_5635,
base64_otp_6279, big, illegal, mime_decode,
- roundtrip].
+ mime_decode_to_string, roundtrip].
%%-------------------------------------------------------------------------
@@ -59,7 +58,7 @@ base64_encode(doc) ->
base64_encode(suite) ->
[];
base64_encode(Config) when is_list(Config) ->
- %% Two pads
+ %% Two pads
<<"QWxhZGRpbjpvcGVuIHNlc2FtZQ==">> =
base64:encode("Aladdin:open sesame"),
%% One pad
@@ -77,8 +76,8 @@ base64_decode(doc) ->
base64_decode(suite) ->
[];
base64_decode(Config) when is_list(Config) ->
- %% Two pads
- <<"Aladdin:open sesame">> =
+ %% Two pads
+ <<"Aladdin:open sesame">> =
base64:decode("QWxhZGRpbjpvcGVuIHNlc2FtZQ=="),
%% One pad
<<"Hello World">> = base64:decode(<<"SGVsbG8gV29ybGQ=">>),
@@ -138,20 +137,85 @@ illegal(Config) when is_list(Config) ->
{'EXIT',{function_clause, _}} = (catch base64:decode("()")),
ok.
%%-------------------------------------------------------------------------
+%% mime_decode and mime_decode_to_string have different implementations
+%% so test both with the same input separately. Both functions have
+%% the same implementation for binary/string arguments.
mime_decode(doc) ->
["Test base64:mime_decode/1."];
mime_decode(suite) ->
[];
mime_decode(Config) when is_list(Config) ->
- %% Two pads
- <<"Aladdin:open sesame">> =
+ %% Test correct padding
+ <<"one">> = base64:mime_decode(<<"b25l">>),
+ <<"on">> = base64:mime_decode(<<"b24=">>),
+ <<"o">> = base64:mime_decode(<<"bw==">>),
+ %% Test 1 extra padding
+ <<"one">> = base64:mime_decode(<<"b25l= =">>),
+ <<"on">> = base64:mime_decode(<<"b24== =">>),
+ <<"o">> = base64:mime_decode(<<"bw=== =">>),
+ %% Test 2 extra padding
+ <<"one">> = base64:mime_decode(<<"b25l===">>),
+ <<"on">> = base64:mime_decode(<<"b24====">>),
+ <<"o">> = base64:mime_decode(<<"bw=====">>),
+ %% Test misc embedded padding
+ <<"one">> = base64:mime_decode(<<"b2=5l===">>),
+ <<"on">> = base64:mime_decode(<<"b=24====">>),
+ <<"o">> = base64:mime_decode(<<"b=w=====">>),
+ %% Test misc white space and illegals with embedded padding
+ <<"one">> = base64:mime_decode(<<" b~2=\r\n5()l===">>),
+ <<"on">> = base64:mime_decode(<<"\tb =2\"�4=�= ==">>),
+ <<"o">> = base64:mime_decode(<<"\nb=w=====">>),
+ %% Two pads
+ <<"Aladdin:open sesame">> =
base64:mime_decode("QWxhZGRpbjpvc()GVuIHNlc2FtZQ=="),
- %% One pad, followed by ignored text
- <<"Hello World">> = base64:mime_decode(<<"SGVsb)(G8gV29ybGQ=apa">>),
+ %% One pad to ignore, followed by more text
+ <<"Hello World!!">> = base64:mime_decode(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>),
+ %% No pad
+ <<"Aladdin:open sesam">> =
+ base64:mime_decode("QWxhZGRpbjpvcG�\")(VuIHNlc2Ft"),
+ %% Encoded base 64 strings may be divided by non base 64 chars.
+ %% In this cases whitespaces.
+ <<"0123456789!@#0^&*();:<>,. []{}">> =
+ base64:mime_decode(
+ <<"MDEy MzQ1Njc4 \tOSFAIzBeJ \nio)(oKTs6 PD4sLi \r\nBbXXt9">>),
+ ok.
+
+%%-------------------------------------------------------------------------
+
+%% Repeat of mime_decode() tests
+mime_decode_to_string(doc) ->
+ ["Test base64:mime_decode_to_string/1."];
+mime_decode_to_string(suite) ->
+ [];
+mime_decode_to_string(Config) when is_list(Config) ->
+ %% Test correct padding
+ "one" = base64:mime_decode_to_string(<<"b25l">>),
+ "on" = base64:mime_decode_to_string(<<"b24=">>),
+ "o" = base64:mime_decode_to_string(<<"bw==">>),
+ %% Test 1 extra padding
+ "one" = base64:mime_decode_to_string(<<"b25l= =">>),
+ "on" = base64:mime_decode_to_string(<<"b24== =">>),
+ "o" = base64:mime_decode_to_string(<<"bw=== =">>),
+ %% Test 2 extra padding
+ "one" = base64:mime_decode_to_string(<<"b25l===">>),
+ "on" = base64:mime_decode_to_string(<<"b24====">>),
+ "o" = base64:mime_decode_to_string(<<"bw=====">>),
+ %% Test misc embedded padding
+ "one" = base64:mime_decode_to_string(<<"b2=5l===">>),
+ "on" = base64:mime_decode_to_string(<<"b=24====">>),
+ "o" = base64:mime_decode_to_string(<<"b=w=====">>),
+ %% Test misc white space and illegals with embedded padding
+ "one" = base64:mime_decode_to_string(<<" b~2=\r\n5()l===">>),
+ "on" = base64:mime_decode_to_string(<<"\tb =2\"�4=�= ==">>),
+ "o" = base64:mime_decode_to_string(<<"\nb=w=====">>),
+ %% Two pads
+ "Aladdin:open sesame" =
+ base64:mime_decode_to_string("QWxhZGRpbjpvc()GVuIHNlc2FtZQ=="),
+ %% One pad to ignore, followed by more text
+ "Hello World!!" = base64:mime_decode_to_string(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>),
%% No pad
"Aladdin:open sesam" =
base64:mime_decode_to_string("QWxhZGRpbjpvcG�\")(VuIHNlc2Ft"),
-
%% Encoded base 64 strings may be divided by non base 64 chars.
%% In this cases whitespaces.
"0123456789!@#0^&*();:<>,. []{}" =
@@ -159,6 +223,7 @@ mime_decode(Config) when is_list(Config) ->
<<"MDEy MzQ1Njc4 \tOSFAIzBeJ \nio)(oKTs6 PD4sLi \r\nBbXXt9">>),
ok.
+%%-------------------------------------------------------------------------
roundtrip(Config) when is_list(Config) ->
Sizes = lists:seq(1, 255) ++ lists:seq(2400-5, 2440),