aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/beam')
-rw-r--r--erts/emulator/beam/atom.names2
-rw-r--r--erts/emulator/beam/beam_bif_load.c2
-rw-r--r--erts/emulator/beam/beam_bp.c8
-rw-r--r--erts/emulator/beam/beam_debug.c27
-rw-r--r--erts/emulator/beam/beam_emu.c557
-rw-r--r--erts/emulator/beam/beam_load.c677
-rw-r--r--erts/emulator/beam/beam_load.h7
-rw-r--r--erts/emulator/beam/bif.c189
-rw-r--r--erts/emulator/beam/bif.h155
-rw-r--r--erts/emulator/beam/big.c56
-rw-r--r--erts/emulator/beam/big.h1
-rw-r--r--erts/emulator/beam/binary.c10
-rw-r--r--erts/emulator/beam/break.c2
-rw-r--r--erts/emulator/beam/dist.c51
-rw-r--r--erts/emulator/beam/erl_arith.c8
-rw-r--r--erts/emulator/beam/erl_bif_binary.c64
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c107
-rw-r--r--erts/emulator/beam/erl_bif_info.c263
-rw-r--r--erts/emulator/beam/erl_bif_lists.c104
-rw-r--r--erts/emulator/beam/erl_bif_op.c25
-rw-r--r--erts/emulator/beam/erl_bif_os.c24
-rw-r--r--erts/emulator/beam/erl_bif_port.c73
-rw-r--r--erts/emulator/beam/erl_bif_re.c135
-rw-r--r--erts/emulator/beam/erl_bif_trace.c103
-rw-r--r--erts/emulator/beam/erl_bits.c12
-rw-r--r--erts/emulator/beam/erl_db.c142
-rw-r--r--erts/emulator/beam/erl_db_tree.c10
-rw-r--r--erts/emulator/beam/erl_db_util.c48
-rw-r--r--erts/emulator/beam/erl_db_util.h6
-rw-r--r--erts/emulator/beam/erl_gc.c7
-rw-r--r--erts/emulator/beam/erl_init.c6
-rw-r--r--erts/emulator/beam/erl_monitors.c8
-rw-r--r--erts/emulator/beam/erl_nif.c64
-rw-r--r--erts/emulator/beam/erl_nif.h3
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h202
-rw-r--r--erts/emulator/beam/erl_process.c11
-rw-r--r--erts/emulator/beam/erl_process.h12
-rw-r--r--erts/emulator/beam/erl_process_lock.c18
-rw-r--r--erts/emulator/beam/erl_term.h8
-rw-r--r--erts/emulator/beam/erl_trace.c13
-rw-r--r--erts/emulator/beam/erl_unicode.c36
-rw-r--r--erts/emulator/beam/erl_vm.h2
-rw-r--r--erts/emulator/beam/external.c33
-rw-r--r--erts/emulator/beam/global.h23
-rw-r--r--erts/emulator/beam/ops.tab176
-rw-r--r--erts/emulator/beam/utils.c105
46 files changed, 2319 insertions, 1276 deletions
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 37738faae3..71454b3e57 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -158,6 +158,8 @@ atom cr
atom crlf
atom creation
atom current_function
+atom current_location
+atom current_stacktrace
atom data
atom debug_flags
atom delay_trap
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 2561d7a630..8c1f85ea37 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -66,8 +66,6 @@ load_module_2(BIF_ALIST_2)
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_block_system(0);
- erts_export_consolidate();
-
hp = HAlloc(BIF_P, 3);
sz = binary_size(BIF_ARG_2);
if ((i = erts_load_module(BIF_P, 0,
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 773baad01f..c90795c343 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -612,9 +612,13 @@ static void bp_hash_delete(bp_time_hash_t *hash) {
static void bp_time_diff(bp_data_time_item_t *item, /* out */
process_breakpoint_time_t *pbt, /* in */
Uint ms, Uint s, Uint us) {
- int dms,ds,dus;
+ int ds,dus;
+#ifdef DEBUG
+ int dms;
+
dms = ms - pbt->ms;
+#endif
ds = s - pbt->s;
dus = us - pbt->us;
@@ -622,7 +626,9 @@ static void bp_time_diff(bp_data_time_item_t *item, /* out */
* this is ok.
*/
+#ifdef DEBUG
ASSERT(dms >= 0 || ds >= 0 || dus >= 0);
+#endif
if (dus < 0) {
dus += 1000000;
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index fffb172c68..18c5081d4c 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -49,15 +49,18 @@ void dbg_bt(Process* p, Eterm* sp);
void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg);
static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr);
-Eterm
-erts_debug_same_2(Process* p, Eterm term1, Eterm term2)
+
+BIF_RETTYPE
+erts_debug_same_2(BIF_ALIST_2)
{
- return (term1 == term2) ? am_true : am_false;
+ return (BIF_ARG_1 == BIF_ARG_2) ? am_true : am_false;
}
-Eterm
-erts_debug_flat_size_1(Process* p, Eterm term)
+BIF_RETTYPE
+erts_debug_flat_size_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm term = BIF_ARG_1;
Uint size = size_object(term);
if (IS_USMALL(0, size)) {
@@ -68,9 +71,13 @@ erts_debug_flat_size_1(Process* p, Eterm term)
}
}
-Eterm
-erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool)
+
+BIF_RETTYPE
+erts_debug_breakpoint_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm MFA = BIF_ARG_1;
+ Eterm bool = BIF_ARG_2;
Eterm* tp;
Eterm mfa[3];
int i;
@@ -175,9 +182,11 @@ erts_debug_instructions_0(BIF_ALIST_0)
return res;
}
-Eterm
-erts_debug_disassemble_1(Process* p, Eterm addr)
+BIF_RETTYPE
+erts_debug_disassemble_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm addr = BIF_ARG_1;
erts_dsprintf_buf_t *dsbufp;
Eterm* hp;
Eterm* tp;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 937b3d9e53..6e6380d6b1 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -303,44 +303,6 @@ extern int count_instructions;
PROCESS_MAIN_CHK_LOCKS((P)); \
ERTS_SMP_UNREQ_PROC_MAIN_LOCK((P))
-#if defined(HYBRID)
-# define POST_BIF_GC_SWAPIN_0(_p, _res) \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \
- } \
- SWAPIN
-
-# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _regs[0] = r(0); \
- _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \
- r(0) = _regs[0]; \
- } \
- SWAPIN
-#else
-# define POST_BIF_GC_SWAPIN_0(_p, _res) \
- ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \
- PROCESS_MAIN_CHK_LOCKS((_p)); \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \
- E = (_p)->stop; \
- } \
- HTOP = HEAP_TOP((_p))
-
-# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \
- ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \
- ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \
- PROCESS_MAIN_CHK_LOCKS((_p)); \
- if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \
- _regs[0] = r(0); \
- _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \
- r(0) = _regs[0]; \
- E = (_p)->stop; \
- } \
- HTOP = HEAP_TOP((_p))
-#endif
-
#define db(N) (N)
#define tb(N) (N)
#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N)))
@@ -794,11 +756,11 @@ extern int count_instructions;
} \
} while (0)
-#define IsFunction2(F, A, Action) \
- do { \
- if (is_function_2(c_p, F, A) != am_true ) {\
- Action; \
- } \
+#define IsFunction2(F, A, Action) \
+ do { \
+ if (erl_is_function(c_p, F, A) != am_true ) { \
+ Action; \
+ } \
} while (0)
#define IsTupleOfArity(Src, Arity, Fail) \
@@ -1145,26 +1107,11 @@ void process_main(void)
Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */
#endif
-#ifndef ERTS_SMP
-#if !HALFWORD_HEAP
- static Eterm save_reg[ERTS_X_REGS_ALLOCATED];
- /* X registers -- not used directly, but
- * through 'reg', because using it directly
- * needs two instructions on a SPARC,
- * while using it through reg needs only
- * one.
- */
-#endif
/*
- * Floating point registers.
- */
- static FloatDef freg[MAX_REG];
-#else
- /* X regisers and floating point registers are located in
+ * X registers and floating point registers are located in
* scheduler specific data.
*/
register FloatDef *freg;
-#endif
/*
* For keeping the negative old value of 'reds' when call saving is active.
@@ -1201,14 +1148,6 @@ void process_main(void)
init_done = 1;
goto init_emulator;
}
-#ifndef ERTS_SMP
-#if !HALFWORD_HEAP
- reg = save_reg; /* XXX: probably wastes a register on x86 */
-#else
- /* Registers need to be heap allocated (correct memory range) for tracing to work */
- reg = erts_alloc(ERTS_ALC_T_BEAM_REGISTER, ERTS_X_REGS_ALLOCATED * sizeof(Eterm));
-#endif
-#endif
c_p = NULL;
reds_used = 0;
goto do_schedule1;
@@ -1229,10 +1168,8 @@ void process_main(void)
#endif
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
-#ifdef ERTS_SMP
- reg = c_p->scheduler_data->save_reg;
- freg = c_p->scheduler_data->freg;
-#endif
+ reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
+ freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
#if !HEAP_ON_C_STACK
tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap;
#endif
@@ -1566,9 +1503,17 @@ void process_main(void)
PRE_BIF_SWAPOUT(c_p);
c_p->fcalls = FCALLS - 1;
- result = send_2(c_p, r(0), x(1));
+ reg[0] = r(0);
+ result = erl_send(c_p, r(0), x(1));
PreFetch(0, next);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 2);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
+ result = erts_gc_after_bif_call(c_p, result, reg, 2);
+ r(0) = reg[0];
+ E = c_p->stop;
+ }
+ HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
r(0) = result;
@@ -1576,10 +1521,9 @@ void process_main(void)
NextPF(0, next);
} else if (c_p->freason == TRAP) {
SET_CP(c_p, I+1);
- SET_I(*((BeamInstr **) (BeamInstr) ((c_p)->def_arg_reg + 3)));
+ SET_I(c_p->i);
SWAPIN;
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
+ r(0) = reg[0];
Dispatch();
}
goto find_func_info;
@@ -2234,16 +2178,16 @@ void process_main(void)
OpCase(bif1_fbsd):
{
- Eterm (*bf)(Process*, Eterm);
- Eterm arg;
+ Eterm (*bf)(Process*, Eterm*);
+ Eterm tmp_reg[1];
Eterm result;
- GetArg1(2, arg);
+ GetArg1(2, tmp_reg[0]);
bf = (BifFunction) Arg(1);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, arg);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2262,17 +2206,17 @@ void process_main(void)
OpCase(bif1_body_bsd):
{
- Eterm (*bf)(Process*, Eterm);
+ Eterm (*bf)(Process*, Eterm*);
- Eterm arg;
+ Eterm tmp_reg[1];
Eterm result;
- GetArg1(1, arg);
+ GetArg1(1, tmp_reg[0]);
bf = (BifFunction) Arg(0);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, arg);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2281,7 +2225,7 @@ void process_main(void)
if (is_value(result)) {
StoreBifResult(2, result);
}
- reg[0] = arg;
+ reg[0] = tmp_reg[0];
SWAPOUT;
I = handle_error(c_p, I, reg, bf);
goto post_error_handling;
@@ -2405,14 +2349,15 @@ void process_main(void)
*/
OpCase(i_bif2_fbd):
{
- Eterm (*bf)(Process*, Eterm, Eterm);
+ Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm (*bf)(Process*, Eterm*);
Eterm result;
bf = (BifFunction) Arg(1);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_arg1, tmp_arg2);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2430,13 +2375,14 @@ void process_main(void)
*/
OpCase(i_bif2_body_bd):
{
- Eterm (*bf)(Process*, Eterm, Eterm);
+ Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm (*bf)(Process*, Eterm*);
Eterm result;
bf = (BifFunction) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, tmp_arg1, tmp_arg2);
+ result = (*bf)(c_p, tmp_reg);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2456,77 +2402,9 @@ void process_main(void)
* The most general BIF call. The BIF may build any amount of data
* on the heap. The result is always returned in r(0).
*/
- OpCase(call_bif0_e):
- {
- Eterm (*bf)(Process*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
-
- PRE_BIF_SWAPOUT(c_p);
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
- }
-
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- r(0) = (*bf)(c_p, I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(r(0)));
- ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN_0(c_p, r(0));
- FCALLS = c_p->fcalls;
- if (is_value(r(0))) {
- CHECK_TERM(r(0));
- Next(1);
- }
- else if (c_p->freason == TRAP) {
- goto call_bif_trap3;
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
- reg[0] = r(0);
- I = handle_error(c_p, I, reg, bf);
- goto post_error_handling;
- }
-
- OpCase(call_bif1_e):
- {
- Eterm (*bf)(Process*, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
- Eterm result;
- BeamInstr *next;
-
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
- }
- PreFetch(1, next);
- PRE_BIF_SWAPOUT(c_p);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, r(0), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 1);
- FCALLS = c_p->fcalls;
- if (is_value(result)) {
- r(0) = result;
- CHECK_TERM(r(0));
- NextPF(1, next);
- } else if (c_p->freason == TRAP) {
- goto call_bif_trap3;
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
- reg[0] = r(0);
- I = handle_error(c_p, I, reg, bf);
- goto post_error_handling;
- }
-
- OpCase(call_bif2_e):
+ OpCase(call_bif_e):
{
- Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
+ Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
Eterm result;
BeamInstr *next;
@@ -2536,61 +2414,29 @@ void process_main(void)
save_calls(c_p, (Export *) Arg(0));
}
PreFetch(1, next);
- CHECK_TERM(r(0));
- CHECK_TERM(x(1));
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, r(0), x(1), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
- ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 2);
- FCALLS = c_p->fcalls;
- if (is_value(result)) {
- r(0) = result;
- CHECK_TERM(r(0));
- NextPF(1, next);
- } else if (c_p->freason == TRAP) {
- goto call_bif_trap3;
- }
-
- /*
- * Error handling. SWAPOUT is not needed because it was done above.
- */
- ASSERT(c_p->stop == E);
reg[0] = r(0);
- I = handle_error(c_p, I, reg, bf);
- goto post_error_handling;
- }
-
- OpCase(call_bif3_e):
- {
- Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
- Eterm result;
- BeamInstr *next;
-
- PRE_BIF_SWAPOUT(c_p);
- c_p->fcalls = FCALLS - 1;
- if (FCALLS <= 0) {
- save_calls(c_p, (Export *) Arg(0));
- }
- PreFetch(1, next);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- result = (*bf)(c_p, r(0), x(1), x(2), I);
+ result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_HOLE_CHECK(c_p);
- POST_BIF_GC_SWAPIN(c_p, result, reg, 3);
+ ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
+ Uint arity = ((Export *)Arg(0))->code[2];
+ result = erts_gc_after_bif_call(c_p, result, reg, arity);
+ E = c_p->stop;
+ }
+ HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
r(0) = result;
CHECK_TERM(r(0));
NextPF(1, next);
} else if (c_p->freason == TRAP) {
- call_bif_trap3:
SET_CP(c_p, I+2);
- SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3)));
+ SET_I(c_p->i);
SWAPIN;
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
- x(2) = c_p->def_arg_reg[2];
+ r(0) = reg[0];
Dispatch();
}
@@ -2598,7 +2444,6 @@ void process_main(void)
* Error handling. SWAPOUT is not needed because it was done above.
*/
ASSERT(c_p->stop == E);
- reg[0] = r(0);
I = handle_error(c_p, I, reg, bf);
goto post_error_handling;
}
@@ -3351,64 +3196,23 @@ void process_main(void)
ASSERT(bif_nif_arity <= 3);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- switch (bif_nif_arity) {
- case 3:
- {
- Eterm (*bf)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- break;
- case 2:
- {
- Eterm (*bf)(Process*, Eterm, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, r(0), x(1), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- break;
- case 1:
- {
- Eterm (*bf)(Process*, Eterm, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, r(0), I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- }
- break;
- case 0:
- {
- Eterm (*bf)(Process*, BeamInstr*) = vbf;
- ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- nif_bif_result = (*bf)(c_p, I);
- ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
- is_non_value(nif_bif_result));
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- break;
- }
- default:
- erl_exit(1, "apply_bif: invalid arity: %u\n",
- bif_nif_arity);
+ reg[0] = r(0);
+ {
+ Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf;
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ nif_bif_result = (*bf)(c_p, reg, I);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
+ is_non_value(nif_bif_result));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ PROCESS_MAIN_CHK_LOCKS(c_p);
}
apply_bif_or_nif_epilogue:
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
ERTS_HOLE_CHECK(c_p);
if (c_p->mbuf) {
- reg[0] = r(0);
nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result,
reg, bif_nif_arity);
- r(0) = reg[0];
}
SWAPIN; /* There might have been a garbage collection. */
FCALLS = c_p->fcalls;
@@ -3419,17 +3223,14 @@ void process_main(void)
c_p->cp = 0;
Goto(*I);
} else if (c_p->freason == TRAP) {
- SET_I(*((BeamInstr **) (UWord) ((c_p)->def_arg_reg + 3)));
- r(0) = c_p->def_arg_reg[0];
- x(1) = c_p->def_arg_reg[1];
- x(2) = c_p->def_arg_reg[2];
+ SET_I(c_p->i);
+ r(0) = reg[0];
if (c_p->flags & F_HIBERNATE_SCHED) {
c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
}
Dispatch();
}
- reg[0] = r(0);
I = handle_error(c_p, c_p->cp, reg, vbf);
goto post_error_handling;
}
@@ -3992,8 +3793,7 @@ void process_main(void)
* too big numbers).
*/
if (is_not_small(val) || val > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL)) ||
- val == make_small(0xFFFEUL) || val == make_small(0xFFFFUL)) {
+ (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) {
goto badarg;
}
Next(2);
@@ -4012,8 +3812,8 @@ void process_main(void)
* the valid range).
*/
if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= tmp_arg1 && tmp_arg1 <= make_small(0xDFFFUL)) ||
- tmp_arg1 == make_small(0xFFFEUL) || tmp_arg1 == make_small(0xFFFFUL)) {
+ (make_small(0xD800UL) <= tmp_arg1 &&
+ tmp_arg1 <= make_small(0xDFFFUL))) {
ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2);
mb->offset -= 32;
@@ -4888,92 +4688,6 @@ void process_main(void)
}
/*
- * Instructions for allocating on the message area.
- */
-
- OpCase(i_global_cons):
- {
- BeamInstr *next;
-#ifdef HYBRID
- Eterm *hp;
-
- PreFetch(0,next);
- TestGlobalHeap(2,2,hp);
- hp[0] = r(0);
- hp[1] = x(1);
- r(0) = make_list(hp);
-#ifndef INCREMENTAL
- global_htop += 2;
-#endif
- NextPF(0,next);
-#else
- PreFetch(0,next);
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- OpCase(i_global_tuple):
- {
- BeamInstr *next;
- int len;
-#ifdef HYBRID
- Eterm list;
- Eterm *hp;
-#endif
-
- if ((len = list_length(r(0))) < 0) {
- goto badarg;
- }
-
- PreFetch(0,next);
-#ifdef HYBRID
- TestGlobalHeap(len + 1,1,hp);
- list = r(0);
- r(0) = make_tuple(hp);
- *hp++ = make_arityval(len);
- while(is_list(list))
- {
- Eterm* cons = list_val(list);
- *hp++ = CAR(cons);
- list = CDR(cons);
- }
-#ifndef INCREMENTAL
- global_htop += len + 1;
-#endif
- NextPF(0,next);
-#else
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- OpCase(i_global_copy):
- {
- BeamInstr *next;
- PreFetch(0,next);
-#ifdef HYBRID
- if (!IS_CONST(r(0)))
- {
- BM_SWAP_TIMER(system,copy);
- SWAPOUT;
- reg[0] = r(0);
- reg[1] = NIL;
- r(0) = copy_struct_lazy(c_p,r(0),0);
- ASSERT(ma_src_top == 0);
- ASSERT(ma_dst_top == 0);
- ASSERT(ma_offset_top == 0);
- SWAPIN;
- BM_SWAP_TIMER(copy,system);
- }
- NextPF(0,next);
-#else
- c_p->freason = EXC_INTERNAL_ERROR;
- goto find_func_info;
-#endif
- }
-
- /*
* New floating point instructions.
*/
@@ -5151,10 +4865,8 @@ void process_main(void)
c_p->def_arg_reg[4] = -neg_o_reds;
reg[0] = r(0);
c_p = hipe_mode_switch(c_p, cmd, reg);
-#ifdef ERTS_SMP
- reg = c_p->scheduler_data->save_reg;
- freg = c_p->scheduler_data->freg;
-#endif
+ reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
+ freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
ERL_BITS_RELOAD_STATEP(c_p);
neg_o_reds = -c_p->def_arg_reg[4];
FCALLS = c_p->fcalls;
@@ -5268,8 +4980,8 @@ void process_main(void)
OpCase(int_code_end):
OpCase(label_L):
- OpCase(too_old_compiler):
OpCase(on_load):
+ OpCase(line_I):
erl_exit(1, "meta op\n");
/*
@@ -5686,6 +5398,25 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) {
* that c_p->ftrace will point to a cons cell which holds the given args
* and the saved data (encoded as a bignum).
*
+ * There is an issue with line number information. Line number
+ * information is associated with the address *before* an operation
+ * that may fail or be stored stored on the stack. But continuation
+ * pointers point after its call instruction, not before. To avoid
+ * finding the wrong line number, we'll need to adjust them so that
+ * they point at the beginning of the call instruction or inside the
+ * call instruction. Since its impractical to point at the beginning,
+ * we'll do the simplest thing and decrement the continuation pointers
+ * by one.
+ *
+ * Here is an example of what can go wrong. Without the adjustment
+ * of continuation pointers, the call at line 42 below would seem to
+ * be at line 43:
+ *
+ * line 42
+ * call ...
+ * line 43
+ * gc_bif ...
+ *
* (It would be much better to put the arglist - when it exists - in the
* error value instead of in the actual trace; e.g. '{badarg, Args}'
* instead of using 'badarg' with Args in the trace. The arglist may
@@ -5752,7 +5483,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
}
/* Save second stack entry if CP is valid and different from pc */
if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) {
- s->trace[s->depth++] = c_p->cp;
+ s->trace[s->depth++] = c_p->cp - 1;
depth--;
}
s->pc = NULL;
@@ -5772,13 +5503,13 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
/* Save first stack entry */
ASSERT(c_p->cp);
if (depth > 0) {
- s->trace[s->depth++] = c_p->cp;
+ s->trace[s->depth++] = c_p->cp - 1;
depth--;
}
s->pc = NULL; /* Ignore pc */
} else {
if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) {
- s->trace[s->depth++] = c_p->cp;
+ s->trace[s->depth++] = c_p->cp - 1;
depth--;
}
s->pc = pc;
@@ -5793,24 +5524,31 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
}
/* Save the actual stack trace */
+ erts_save_stacktrace(c_p, s, depth);
+}
+
+void
+erts_save_stacktrace(Process* p, struct StackTrace* s, int depth)
+{
if (depth > 0) {
Eterm *ptr;
BeamInstr *prev = s->depth ? s->trace[s->depth-1] : NULL;
BeamInstr i_return_trace = beam_return_trace[0];
BeamInstr i_return_to_trace = beam_return_to_trace[0];
+
/*
* Traverse the stack backwards and add all unique continuation
* pointers to the buffer, up to the maximum stack trace size.
*
* Skip trace stack frames.
*/
- ptr = c_p->stop;
- if (ptr < STACK_START(c_p)
- && (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace &&
- *cp_val(*ptr) != i_return_to_trace))
- && c_p->cp) {
- /* Can not follow cp here - code may be unloaded */
- BeamInstr *cpp = c_p->cp;
+ ptr = p->stop;
+ if (ptr < STACK_START(p) &&
+ (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace &&
+ *cp_val(*ptr) != i_return_to_trace)) &&
+ p->cp) {
+ /* Cannot follow cp here - code may be unloaded */
+ BeamInstr *cpp = p->cp;
if (cpp == beam_exception_trace || cpp == beam_return_trace) {
/* Skip return_trace parameters */
ptr += 2;
@@ -5819,7 +5557,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
ptr += 1;
}
}
- while (ptr < STACK_START(c_p) && depth > 0) {
+ while (ptr < STACK_START(p) && depth > 0) {
if (is_CP(*ptr)) {
if (*cp_val(*ptr) == i_return_trace) {
/* Skip stack frame variables */
@@ -5834,7 +5572,7 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf,
if (cp != prev) {
/* Record non-duplicates only */
prev = cp;
- s->trace[s->depth++] = cp;
+ s->trace[s->depth++] = cp - 1;
depth--;
}
ptr++;
@@ -5902,9 +5640,14 @@ build_stacktrace(Process* c_p, Eterm exc) {
struct StackTrace* s;
Eterm args;
int depth;
- BeamInstr* current;
- Eterm Where = NIL;
- Eterm *next_p = &Where;
+ FunctionInfo fi;
+ FunctionInfo* stk;
+ FunctionInfo* stkp;
+ Eterm res = NIL;
+ Uint heap_size;
+ Eterm* hp;
+ Eterm mfa;
+ int i;
if (! (s = get_trace_from_exc(exc))) {
return NIL;
@@ -5923,64 +5666,56 @@ build_stacktrace(Process* c_p, Eterm exc) {
* saved s->current should already contain the proper value.
*/
if (s->pc != NULL) {
- current = find_function_from_pc(s->pc);
+ erts_lookup_function_info(&fi, s->pc, 1);
+ } else if (GET_EXC_INDEX(s->freason) ==
+ GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) {
+ erts_lookup_function_info(&fi, s->current, 1);
} else {
- current = s->current;
+ erts_set_current_function(&fi, s->current);
}
+
/*
- * If current is still NULL, default to the initial function
+ * If fi.current is still NULL, default to the initial function
* (e.g. spawn_link(erlang, abs, [1])).
*/
- if (current == NULL) {
- current = c_p->initial;
+ if (fi.current == NULL) {
+ erts_set_current_function(&fi, c_p->initial);
args = am_true; /* Just in case */
} else {
args = get_args_from_exc(exc);
}
- depth = s->depth;
-
/*
- * Add the {M,F,A} for the current function
- * (where A is arity or [Argument]).
+ * Look up all saved continuation pointers and calculate
+ * needed heap space.
*/
- {
- int i;
- Eterm mfa;
- Uint heap_size = 6*(depth+1);
- Eterm* hp = HAlloc(c_p, heap_size);
- Eterm* hp_end = hp + heap_size;
-
- if (args != am_true) {
- /* We have an arglist - use it */
- mfa = TUPLE3(hp, current[0], current[1], args);
- } else {
- Eterm arity = make_small(current[2]);
- mfa = TUPLE3(hp, current[0], current[1], arity);
+ depth = s->depth;
+ stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
+ depth*sizeof(FunctionInfo));
+ heap_size = fi.needed + 2;
+ for (i = 0; i < depth; i++) {
+ erts_lookup_function_info(stkp, s->trace[i], 1);
+ if (stkp->current) {
+ heap_size += stkp->needed + 2;
+ stkp++;
}
- hp += 4;
- ASSERT(*next_p == NIL);
- *next_p = CONS(hp, mfa, NIL);
- next_p = &CDR(list_val(*next_p));
- hp += 2;
+ }
- /*
- * Finally, we go through the saved continuation pointers.
- */
- for (i = 0; i < depth; i++) {
- BeamInstr *fi = find_function_from_pc((BeamInstr *) s->trace[i]);
- if (fi == NULL) continue;
- mfa = TUPLE3(hp, fi[0], fi[1], make_small(fi[2]));
- hp += 4;
- ASSERT(*next_p == NIL);
- *next_p = CONS(hp, mfa, NIL);
- next_p = &CDR(list_val(*next_p));
- hp += 2;
- }
- ASSERT(hp <= hp_end);
- HRelease(c_p, hp_end, hp);
+ /*
+ * Allocate heap space and build the stacktrace.
+ */
+ hp = HAlloc(c_p, heap_size);
+ while (stkp > stk) {
+ stkp--;
+ hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
+ res = CONS(hp, mfa, res);
+ hp += 2;
}
- return Where;
+ hp = erts_build_mfa_item(&fi, hp, args, &mfa);
+ res = CONS(hp, mfa, res);
+
+ erts_free(ERTS_ALC_T_TMP, (void *) stk);
+ return res;
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index fceb352cf3..3836f1ae96 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -158,6 +158,7 @@ typedef struct {
#define LITERAL_CHUNK 6
#define ATTR_CHUNK 7
#define COMPILE_CHUNK 8
+#define LINE_CHUNK 9
#define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0]))
@@ -182,6 +183,7 @@ static Uint chunk_types[] = {
MakeIffId('L', 'i', 't', 'T'), /* 6 */
MakeIffId('A', 't', 't', 'r'), /* 7 */
MakeIffId('C', 'I', 'n', 'f'), /* 8 */
+ MakeIffId('L', 'i', 'n', 'e'), /* 9 */
};
/*
@@ -231,6 +233,15 @@ struct string_patch {
};
/*
+ * This structure associates a code offset with a source code location.
+ */
+
+typedef struct {
+ int pos; /* Position in code */
+ Uint32 loc; /* Location in source code */
+} LineInstr;
+
+/*
* This structure contains all information about the module being loaded.
*/
@@ -325,6 +336,19 @@ typedef struct {
Literal* literals; /* Array of literals. */
LiteralPatch* literal_patches; /* Operands that need to be patched. */
Uint total_literal_size; /* Total heap size for all literals. */
+
+ /*
+ * Line table.
+ */
+ BeamInstr* line_item; /* Line items from the BEAM file. */
+ int num_line_items; /* Number of line items. */
+ LineInstr* line_instr; /* Line instructions */
+ int num_line_instrs; /* Maximum number of line instructions */
+ int current_li; /* Current line instruction */
+ int* func_line; /* Mapping from function to first line instr */
+ Eterm* fname; /* List of file names */
+ int num_fnames; /* Number of filenames in fname table */
+ int loc_size; /* Size of location info in bytes (2/4) */
} LoaderState;
typedef struct {
@@ -332,6 +356,27 @@ typedef struct {
Eterm* func_tab[1]; /* Pointers to each function. */
} LoadedCode;
+/*
+ * Layout of the line table.
+ */
+
+#define MI_LINE_FNAME_PTR 0
+#define MI_LINE_LOC_TAB 1
+#define MI_LINE_LOC_SIZE 2
+#define MI_LINE_FUNC_TAB 3
+
+#define LINE_INVALID_LOCATION (0)
+
+/*
+ * Macros for manipulating locations.
+ */
+
+#define IS_VALID_LOCATION(File, Line) \
+ ((unsigned) (File) < 255 && (unsigned) (Line) < ((1 << 24) - 1))
+#define MAKE_LOCATION(File, Line) (((File) << 24) | (Line))
+#define LOC_FILE(Loc) ((Loc) >> 24)
+#define LOC_LINE(Loc) ((Loc) & ((1 << 24)-1))
+
#define GetTagAndValue(Stp, Tag, Val) \
do { \
BeamInstr __w; \
@@ -468,6 +513,7 @@ static int load_import_table(LoaderState* stp);
static int read_export_table(LoaderState* stp);
static int read_lambda_table(LoaderState* stp);
static int read_literal_table(LoaderState* stp);
+static int read_line_table(LoaderState* stp);
static int read_code_header(LoaderState* stp);
static int load_code(LoaderState* stp);
static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
@@ -506,6 +552,8 @@ static Eterm native_addresses(Process* p, Eterm mod);
int patch_funentries(Eterm Patchlist);
int patch(Eterm Addresses, Uint fe);
static int safe_mul(UWord a, UWord b, UWord* resp);
+static void lookup_loc(FunctionInfo* fi, BeamInstr* pc,
+ BeamInstr* modp, int idx);
static int must_swap_floats;
@@ -698,6 +746,26 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
}
/*
+ * Read the line table (if present).
+ */
+
+ CHKBLK(ERTS_ALC_T_CODE,state.code);
+ if (state.chunks[LINE_CHUNK].size > 0) {
+ define_file(&state, "line table", LINE_CHUNK);
+ if (!read_line_table(&state)) {
+ goto load_error;
+ }
+ }
+
+ /*
+ * Since the literal table *may* have contained external
+ * funs (containing references to export entries), now is
+ * the time to consolidate the export tables.
+ */
+
+ erts_export_consolidate();
+
+ /*
* Load the code chunk.
*/
@@ -805,6 +873,22 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
state.genop_blocks = next;
}
+ if (state.line_item != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, state.line_item);
+ }
+
+ if (state.line_instr != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, state.line_instr);
+ }
+
+ if (state.func_line != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, state.func_line);
+ }
+
+ if (state.fname != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, state.fname);
+ }
+
return rval;
}
@@ -835,6 +919,10 @@ init_state(LoaderState* stp)
stp->string_patches = 0;
stp->may_load_nif = 0;
stp->on_load = 0;
+ stp->line_item = 0;
+ stp->line_instr = 0;
+ stp->func_line = 0;
+ stp->fname = 0;
}
static int
@@ -1324,6 +1412,138 @@ read_literal_table(LoaderState* stp)
return 0;
}
+static int
+read_line_table(LoaderState* stp)
+{
+ unsigned version;
+ unsigned flags;
+ int num_line_items;
+ BeamInstr* lp;
+ int i;
+ BeamInstr fname_index;
+ BeamInstr tag;
+
+ /*
+ * If the emulator flag ignoring the line information was given,
+ * return immediately.
+ */
+
+ if (erts_no_line_info) {
+ return 1;
+ }
+
+ /*
+ * Check version of line table.
+ */
+
+ GetInt(stp, 4, version);
+ if (version != 0) {
+ /*
+ * Wrong version. Silently ignore the line number chunk.
+ */
+ return 1;
+ }
+
+ /*
+ * Read the remaining header words. The flag word is reserved
+ * for possible future use; for the moment we ignore it.
+ */
+ GetInt(stp, 4, flags);
+ GetInt(stp, 4, stp->num_line_instrs);
+ GetInt(stp, 4, num_line_items);
+ GetInt(stp, 4, stp->num_fnames);
+
+ /*
+ * Calculate space and allocate memory for the line item table.
+ */
+
+ num_line_items++;
+ lp = (BeamInstr *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ num_line_items * sizeof(BeamInstr));
+ stp->line_item = lp;
+ stp->num_line_items = num_line_items;
+
+ /*
+ * The zeroth entry in the line item table is special.
+ * It contains the undefined location.
+ */
+
+ *lp++ = LINE_INVALID_LOCATION;
+ num_line_items--;
+
+ /*
+ * Read all the line items.
+ */
+
+ stp->loc_size = stp->num_fnames ? 4 : 2;
+ fname_index = 0;
+ while (num_line_items-- > 0) {
+ BeamInstr val;
+ BeamInstr loc;
+
+ GetTagAndValue(stp, tag, val);
+ if (tag == TAG_i) {
+ if (IS_VALID_LOCATION(fname_index, val)) {
+ loc = MAKE_LOCATION(fname_index, val);
+ } else {
+ /*
+ * Too many files or huge line number. Silently invalidate
+ * the location.
+ */
+ loc = LINE_INVALID_LOCATION;
+ }
+ *lp++ = loc;
+ if (val > 0xFFFF) {
+ stp->loc_size = 4;
+ }
+ } else if (tag == TAG_a) {
+ if (val > stp->num_fnames) {
+ LoadError2(stp, "file index overflow (%d/%d)",
+ val, stp->num_fnames);
+ }
+ fname_index = val;
+ num_line_items++;
+ } else {
+ LoadError1(stp, "bad tag '%c' (expected 'a' or 'i')",
+ tag_to_letter[tag]);
+ }
+ }
+
+ /*
+ * Read all filenames.
+ */
+
+ if (stp->num_fnames != 0) {
+ stp->fname = (Eterm *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ stp->num_fnames *
+ sizeof(Eterm));
+ for (i = 0; i < stp->num_fnames; i++) {
+ byte* fname;
+ Uint n;
+
+ GetInt(stp, 2, n);
+ GetString(stp, fname, n);
+ stp->fname[i] = am_atom_put((char*)fname, n);
+ }
+ }
+
+ /*
+ * Allocate the arrays to be filled while code is being loaded.
+ */
+ stp->line_instr = (LineInstr *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ stp->num_line_instrs *
+ sizeof(LineInstr));
+ stp->current_li = 0;
+ stp->func_line = (int *) erts_alloc(ERTS_ALC_T_LOADER_TMP,
+ stp->num_functions *
+ sizeof(int));
+
+ return 1;
+
+ load_error:
+ return 0;
+}
+
static int
read_code_header(LoaderState* stp)
@@ -1358,10 +1578,15 @@ read_code_header(LoaderState* stp)
/*
* Verify the number of the highest opcode used.
*/
-
GetInt(stp, 4, opcode_max);
if (opcode_max > MAX_GENERIC_OPCODE) {
- LoadError2(stp, "use of opcode %d; this emulator supports only up to %d",
+ LoadError2(stp,
+ "This BEAM file was compiled for a later version"
+ " of the run-time system than " ERLANG_OTP_RELEASE ".\n"
+ " To fix this, please recompile this module with an "
+ ERLANG_OTP_RELEASE " compiler.\n"
+ " (Use of opcode %d; this emulator supports "
+ "only up to %d.)",
opcode_max, MAX_GENERIC_OPCODE);
}
@@ -1415,7 +1640,7 @@ load_code(LoaderState* stp)
{
int i;
int ci;
- int last_func_start = 0;
+ int last_func_start = 0; /* Needed by nif loading and line instructions */
char* sign;
int arg; /* Number of current argument. */
int num_specific; /* Number of specific ops for current. */
@@ -1428,6 +1653,14 @@ load_code(LoaderState* stp)
GenOp** last_op_next = NULL;
int arity;
+ /*
+ * The size of the loaded func_info instruction is needed
+ * by both the nif functionality and line instructions.
+ */
+ enum {
+ FUNC_INFO_SZ = 5
+ };
+
code = stp->code;
code_buffer_size = stp->code_buffer_size;
ci = stp->ci;
@@ -1667,14 +1900,6 @@ load_code(LoaderState* stp)
}
/*
- * Special error message instruction.
- */
- if (stp->genop->op == genop_too_old_compiler_0) {
- LoadError0(stp, "please re-compile this module with an "
- ERLANG_OTP_RELEASE " compiler");
- }
-
- /*
* From the collected generic instruction, find the specific
* instruction.
*/
@@ -1725,7 +1950,27 @@ load_code(LoaderState* stp)
ERLANG_OTP_RELEASE " compiler ");
}
- LoadError0(stp, "no specific operation found");
+ /*
+ * Some generic instructions should have a special
+ * error message.
+ */
+ switch (stp->genop->op) {
+ case genop_too_old_compiler_0:
+ LoadError0(stp, "please re-compile this module with an "
+ ERLANG_OTP_RELEASE " compiler");
+ case genop_unsupported_guard_bif_3:
+ {
+ Eterm Mod = (Eterm) stp->genop->a[0].val;
+ Eterm Name = (Eterm) stp->genop->a[1].val;
+ Uint arity = (Uint) stp->genop->a[2].val;
+ FREE_GENOP(stp, stp->genop);
+ stp->genop = 0;
+ LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n",
+ Mod, Name, arity);
+ }
+ default:
+ LoadError0(stp, "no specific operation found");
+ }
}
stp->specific_op = specific;
@@ -2014,7 +2259,6 @@ load_code(LoaderState* stp)
case op_i_func_info_IaaI:
{
Uint offset;
- enum { FINFO_SZ = 5 };
if (function_number >= stp->num_functions) {
LoadError1(stp, "too many functions in module (header said %d)",
@@ -2022,27 +2266,37 @@ load_code(LoaderState* stp)
}
if (stp->may_load_nif) {
- const int finfo_ix = ci - FINFO_SZ;
+ const int finfo_ix = ci - FUNC_INFO_SZ;
enum { MIN_FUNC_SZ = 3 };
if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) {
/* Must make room for call_nif op */
int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start);
ASSERT(pad > 0 && pad < MIN_FUNC_SZ);
CodeNeed(pad);
- sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], FINFO_SZ*sizeof(BeamInstr));
+ sys_memmove(&code[finfo_ix+pad], &code[finfo_ix],
+ FUNC_INFO_SZ*sizeof(BeamInstr));
sys_memset(&code[finfo_ix], 0, pad*sizeof(BeamInstr));
ci += pad;
stp->labels[last_label].value += pad;
}
}
last_func_start = ci;
+
+ /*
+ * Save current offset of into the line instruction array.
+ */
+
+ if (stp->func_line) {
+ stp->func_line[function_number] = stp->current_li;
+ }
+
/*
* Save context for error messages.
*/
stp->function = code[ci-2];
stp->arity = code[ci-1];
- ASSERT(stp->labels[last_label].value == ci - FINFO_SZ);
+ ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ);
offset = MI_FUNCTIONS + function_number;
code[offset] = stp->labels[last_label].patches;
stp->labels[last_label].patches = offset;
@@ -2105,6 +2359,45 @@ load_code(LoaderState* stp)
stp->catches = ci-3;
break;
+ case op_line_I:
+ if (stp->line_item) {
+ BeamInstr item = code[ci-1];
+ BeamInstr loc;
+ int li;
+ if (item >= stp->num_line_items) {
+ LoadError2(stp, "line instruction index overflow (%d/%d)",
+ item, stp->num_line_items);
+ }
+ li = stp->current_li;
+ if (li >= stp->num_line_instrs) {
+ LoadError2(stp, "line instruction table overflow (%d/%d)",
+ li, stp->num_line_instrs);
+ }
+ loc = stp->line_item[item];
+
+ if (ci - 2 == last_func_start) {
+ /*
+ * This line instruction directly follows the func_info
+ * instruction. Its address must be adjusted to point to
+ * func_info instruction.
+ */
+ stp->line_instr[li].pos = last_func_start - FUNC_INFO_SZ;
+ stp->line_instr[li].loc = stp->line_item[item];
+ stp->current_li++;
+ } else if (li <= stp->func_line[function_number-1] ||
+ stp->line_instr[li-1].loc != loc) {
+ /*
+ * Only store the location if it is different
+ * from the previous location in the same function.
+ */
+ stp->line_instr[li].pos = ci - 2;
+ stp->line_instr[li].loc = stp->line_item[item];
+ stp->current_li++;
+ }
+ }
+ ci -= 2; /* Get rid of the instruction */
+ break;
+
/*
* End of code found.
*/
@@ -2141,6 +2434,8 @@ load_code(LoaderState* stp)
#define no_fpe_signals(St) 0
#endif
+#define never(St) 0
+
/*
* Predicate that tests whether a jump table can be used.
*/
@@ -3396,10 +3691,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_i_gc_bif1_5;
- op->arity = 5;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
@@ -3420,19 +3712,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
} else if (bf == trunc_1) {
op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_i_gc_bif1_5;
+ op->arity = 5;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = Src;
op->a[3] = Live;
op->a[4] = Dst;
- op->next = NULL;
return op;
}
/*
- * This is used by the ops.tab rule that rewrites gc_bifs with two parameters
+ * This is used by the ops.tab rule that rewrites gc_bifs with two parameters.
* The instruction returned is then again rewritten to an i_load instruction
- * folowed by i_gc_bif2_jIId, to handle literals properly.
+ * followed by i_gc_bif2_jIId, to handle literals properly.
* As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is
* always rewritten, regardless of if there actually are any literals.
*/
@@ -3444,31 +3747,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_ii_gc_bif2_6;
- op->arity = 6;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == binary_part_2) {
op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_ii_gc_bif2_6;
+ op->arity = 6;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = S1;
op->a[3] = S2;
op->a[4] = Live;
op->a[5] = Dst;
- op->next = NULL;
return op;
}
/*
- * This is used by the ops.tab rule that rewrites gc_bifs with three parameters
+ * This is used by the ops.tab rule that rewrites gc_bifs with three parameters.
* The instruction returned is then again rewritten to a move instruction that
* uses r[0] for temp storage, followed by an i_load instruction,
- * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
+ * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
* always occur, as with the gc_bif2 counterpart.
*/
static GenOp*
@@ -3479,18 +3790,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
BifFunction bf;
NEW_GENOP(stp, op);
- op->op = genop_ii_gc_bif3_7;
- op->arity = 7;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
+ op->next = NULL;
bf = stp->import[Bif.val].bf;
/* The translations here need to have a reverse counterpart in
beam_emu.c:translate_gc_bif for error handling to work properly. */
if (bf == binary_part_3) {
op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3;
} else {
- abort();
+ op->op = genop_unsupported_guard_bif_3;
+ op->arity = 3;
+ op->a[0].type = TAG_a;
+ op->a[0].val = stp->import[Bif.val].module;
+ op->a[1].type = TAG_a;
+ op->a[1].val = stp->import[Bif.val].function;
+ op->a[2].type = TAG_u;
+ op->a[2].val = stp->import[Bif.val].arity;
+ return op;
}
+ op->op = genop_ii_gc_bif3_7;
+ op->arity = 7;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
op->a[2] = S1;
op->a[3] = S2;
op->a[4] = S3;
@@ -3570,6 +3890,7 @@ freeze_code(LoaderState* stp)
Uint size;
unsigned catches;
Sint decoded_size;
+ Uint line_size;
/*
* Verify that there was a correct 'FunT' chunk if there were
@@ -3580,13 +3901,19 @@ freeze_code(LoaderState* stp)
LoadError0(stp, stp->lambda_error);
}
-
/*
* Calculate the final size of the code.
*/
-
- size = (stp->ci * sizeof(BeamInstr)) + (stp->total_literal_size * sizeof(Eterm)) +
- strtab_size + attr_size + compile_size;
+ if (stp->line_instr == 0) {
+ line_size = 0;
+ } else {
+ line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) +
+ (stp->current_li+1) + stp->num_fnames) *
+ sizeof(Eterm) + (stp->current_li+1) * stp->loc_size;
+ }
+ size = (stp->ci * sizeof(BeamInstr)) +
+ (stp->total_literal_size * sizeof(Eterm)) +
+ strtab_size + attr_size + compile_size + line_size;
/*
* Move the code to its final location.
@@ -3674,15 +4001,66 @@ freeze_code(LoaderState* stp)
}
literal_end += stp->total_literal_size;
}
-
+ CHKBLK(ERTS_ALC_T_CODE,code);
+
/*
- * Place the string table and, optionally, attributes, after the literal heap.
+ * If there is line information, place it here.
*/
- CHKBLK(ERTS_ALC_T_CODE,code);
+ if (stp->line_instr == 0) {
+ code[MI_LINE_TABLE] = (BeamInstr) 0;
+ str_table = (byte *) literal_end;
+ } else {
+ Eterm* line_tab = (Eterm *) literal_end;
+ Eterm* p;
+ int ftab_size = stp->num_functions;
+ int num_instrs = stp->current_li;
+ Eterm* first_line_item;
+
+ code[MI_LINE_TABLE] = (BeamInstr) line_tab;
+ p = line_tab + MI_LINE_FUNC_TAB;
+
+ first_line_item = (p + ftab_size + 1);
+ for (i = 0; i < ftab_size; i++) {
+ *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]);
+ }
+ *p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs);
+ ASSERT(p == first_line_item);
+ for (i = 0; i < num_instrs; i++) {
+ *p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos);
+ }
+ *p++ = (Eterm) (BeamInstr) (code + stp->ci - 1);
+
+ line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p;
+ memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm));
+ p += stp->num_fnames;
+
+ line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p;
+ line_tab[MI_LINE_LOC_SIZE] = stp->loc_size;
+ if (stp->loc_size == 2) {
+ Uint16* locp = (Uint16 *) p;
+ for (i = 0; i < num_instrs; i++) {
+ *locp++ = (Uint16) stp->line_instr[i].loc;
+ }
+ *locp++ = LINE_INVALID_LOCATION;
+ str_table = (byte *) locp;
+ } else {
+ Uint32* locp = (Uint32 *) p;
+ ASSERT(stp->loc_size == 4);
+ for (i = 0; i < num_instrs; i++) {
+ *locp++ = stp->line_instr[i].loc;
+ }
+ *locp++ = LINE_INVALID_LOCATION;
+ str_table = (byte *) locp;
+ }
- sys_memcpy(literal_end, stp->chunks[STR_CHUNK].start, strtab_size);
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ }
+
+ /*
+ * Place the string table and, optionally, attributes here.
+ */
+ sys_memcpy(str_table, stp->chunks[STR_CHUNK].start, strtab_size);
CHKBLK(ERTS_ALC_T_CODE,code);
- str_table = (byte *) literal_end;
if (attr_size) {
byte* attr = str_table + strtab_size;
sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size);
@@ -3899,6 +4277,7 @@ transform_engine(LoaderState* st)
GenOp* instr;
Uint* pc;
int rval;
+ static Uint restart_fail[1] = {TOP_fail};
ASSERT(gen_opc[st->genop->op].transform != -1);
pc = op_transform + gen_opc[st->genop->op].transform;
@@ -3912,7 +4291,6 @@ transform_engine(LoaderState* st)
ASSERT(restart != NULL);
pc = restart;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
- ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail);
instr = st->genop;
#define RETURN(r) rval = (r); goto do_return;
@@ -3925,7 +4303,9 @@ transform_engine(LoaderState* st)
op = *pc++;
switch (op) {
- case TOP_is_op:
+ case TOP_next_instr:
+ instr = instr->next;
+ ap = 0;
if (instr == NULL) {
/*
* We'll need at least one more instruction to decide whether
@@ -4112,10 +4492,6 @@ transform_engine(LoaderState* st)
case TOP_next_arg:
ap++;
break;
- case TOP_next_instr:
- instr = instr->next;
- ap = 0;
- break;
case TOP_commit:
instr = instr->next; /* The next_instr was optimized away. */
@@ -4133,8 +4509,8 @@ transform_engine(LoaderState* st)
#endif
break;
-#if defined(TOP_call)
- case TOP_call:
+#if defined(TOP_call_end)
+ case TOP_call_end:
{
GenOp** lastp;
GenOp* new_instr;
@@ -4171,7 +4547,7 @@ transform_engine(LoaderState* st)
*lastp = st->genop;
st->genop = new_instr;
}
- break;
+ RETURN(TE_OK);
#endif
case TOP_new_instr:
/*
@@ -4180,12 +4556,10 @@ transform_engine(LoaderState* st)
NEW_GENOP(st, instr);
instr->next = st->genop;
st->genop = instr;
+ instr->op = op = *pc++;
+ instr->arity = gen_opc[op].arity;
ap = 0;
break;
- case TOP_store_op:
- instr->op = *pc++;
- instr->arity = *pc++;
- break;
case TOP_store_type:
i = *pc++;
instr->a[ap].type = i;
@@ -4195,21 +4569,25 @@ transform_engine(LoaderState* st)
i = *pc++;
instr->a[ap].val = i;
break;
- case TOP_store_var:
+ case TOP_store_var_next_arg:
i = *pc++;
ASSERT(i < TE_MAX_VARS);
instr->a[ap].type = var[i].type;
instr->a[ap].val = var[i].val;
+ ap++;
break;
case TOP_try_me_else:
restart = pc + 1;
restart += *pc++;
ASSERT(*pc < NUM_TOPS); /* Valid instruction? */
break;
+ case TOP_try_me_else_fail:
+ restart = restart_fail;
+ break;
case TOP_end:
RETURN(TE_OK);
case TOP_fail:
- RETURN(TE_FAIL)
+ RETURN(TE_FAIL);
default:
ASSERT(0);
}
@@ -4810,17 +5188,24 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
return result;
}
-
/*
- * Returns a pointer to {module, function, arity}, or NULL if not found.
+ * Find a function from the given pc and fill information in
+ * the FunctionInfo struct. If the full_info is non-zero, fill
+ * in all available information (including location in the
+ * source code). If no function is found, the 'current' field
+ * will be set to NULL.
*/
-BeamInstr *
-find_function_from_pc(BeamInstr* pc)
+
+void
+erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
{
Range* low = modules;
Range* high = low + num_loaded_modules;
Range* mid = mid_module;
+ fi->current = NULL;
+ fi->needed = 5;
+ fi->loc = LINE_INVALID_LOCATION;
while (low < high) {
if (pc < mid->start) {
high = mid;
@@ -4837,25 +5222,159 @@ find_function_from_pc(BeamInstr* pc)
high1 = mid1;
} else if (pc < mid1[1]) {
mid_module = mid;
- return mid1[0]+2;
+ fi->current = mid1[0]+2;
+ if (full_info) {
+ BeamInstr** fp = (BeamInstr **) (mid->start +
+ MI_FUNCTIONS);
+ int idx = mid1 - fp;
+ lookup_loc(fi, pc, mid->start, idx);
+ }
+ return;
} else {
low1 = mid1 + 1;
}
}
- return NULL;
+ return;
}
mid = low + (high-low) / 2;
}
- return NULL;
+}
+
+static void
+lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx)
+{
+ Eterm* line = (Eterm *) modp[MI_LINE_TABLE];
+ Eterm* low;
+ Eterm* high;
+ Eterm* mid;
+ Eterm pc;
+
+ if (line == 0) {
+ return;
+ }
+
+ pc = (Eterm) (BeamInstr) orig_pc;
+ fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR];
+ low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx];
+ high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1];
+ while (high > low) {
+ mid = low + (high-low) / 2;
+ if (pc < mid[0]) {
+ high = mid;
+ } else if (pc < mid[1]) {
+ int file;
+ int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB];
+
+ if (line[MI_LINE_LOC_SIZE] == 2) {
+ Uint16* loc_table =
+ (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB];
+ fi->loc = loc_table[index];
+ } else {
+ Uint32* loc_table =
+ (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB];
+ ASSERT(line[MI_LINE_LOC_SIZE] == 4);
+ fi->loc = loc_table[index];
+ }
+ if (fi->loc == LINE_INVALID_LOCATION) {
+ return;
+ }
+ fi->needed += 3+2+3+2;
+ file = LOC_FILE(fi->loc);
+ if (file == 0) {
+ /* Special case: Module name with ".erl" appended */
+ Atom* mod_atom = atom_tab(atom_val(fi->current[0]));
+ fi->needed += 2*(mod_atom->len+4);
+ } else {
+ Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1]));
+ fi->needed += 2*ap->len;
+ }
+ return;
+ } else {
+ low = mid + 1;
+ }
+ }
+}
+
+/*
+ * Build a single {M,F,A,Loction} item to be part of
+ * a stack trace.
+ */
+Eterm*
+erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p)
+{
+ BeamInstr* current = fi->current;
+ Eterm loc = NIL;
+
+ if (fi->loc != LINE_INVALID_LOCATION) {
+ Eterm tuple;
+ int line = LOC_LINE(fi->loc);
+ int file = LOC_FILE(fi->loc);
+ Eterm file_term = NIL;
+
+ if (file == 0) {
+ Atom* ap = atom_tab(atom_val(fi->current[0]));
+ file_term = buf_to_intlist(&hp, ".erl", 4, NIL);
+ file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term);
+ } else {
+ Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1]));
+ file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, NIL);
+ }
+
+ tuple = TUPLE2(hp, am_line, make_small(line));
+ hp += 3;
+ loc = CONS(hp, tuple, loc);
+ hp += 2;
+ tuple = TUPLE2(hp, am_file, file_term);
+ hp += 3;
+ loc = CONS(hp, tuple, loc);
+ hp += 2;
+ }
+
+ if (is_list(args) || is_nil(args)) {
+ *mfa_p = TUPLE4(hp, current[0], current[1], args, loc);
+ } else {
+ Eterm arity = make_small(current[2]);
+ *mfa_p = TUPLE4(hp, current[0], current[1], arity, loc);
+ }
+ return hp + 5;
+}
+
+/*
+ * Force setting of the current function in a FunctionInfo
+ * structure. No source code location will be associated with
+ * the function.
+ */
+void
+erts_set_current_function(FunctionInfo* fi, BeamInstr* current)
+{
+ fi->current = current;
+ fi->needed = 5;
+ fi->loc = LINE_INVALID_LOCATION;
+}
+
+
+/*
+ * Returns a pointer to {module, function, arity}, or NULL if not found.
+ */
+BeamInstr*
+find_function_from_pc(BeamInstr* pc)
+{
+ FunctionInfo fi;
+
+ erts_lookup_function_info(&fi, pc, 0);
+ return fi.current;
}
/*
* Read a specific chunk from a Beam binary.
*/
-Eterm
-code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
+BIF_RETTYPE
+code_get_chunk_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm Bin = BIF_ARG_1;
+ Eterm Chunk = BIF_ARG_2;
LoaderState state;
Uint chunk = 0;
ErlSubBin* sb;
@@ -4920,9 +5439,11 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
* Calculate the MD5 for a module.
*/
-Eterm
-code_module_md5_1(Process* p, Eterm Bin)
+BIF_RETTYPE
+code_module_md5_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm Bin = BIF_ARG_1;
LoaderState state;
byte* temp_alloc = NULL;
@@ -5179,7 +5700,17 @@ patch_funentries(Eterm Patchlist)
fe = erts_get_fun_entry(Mod, uniq, index);
fe->native_address = (Uint *)native_address;
- erts_refc_dec(&fe->refc, 1);
+
+ /* Deliberate MEMORY LEAK of native fun entries!!!
+ *
+ * Uncomment line below when hipe code upgrade and purging works correctly.
+ * Today we may get cases when old (leaked) native code of a purged module
+ * gets called and tries to create instances of a deleted fun entry.
+ *
+ * Reproduced on a debug emulator with stdlib_test/qlc_SUITE:join_merge
+ *
+ * erts_refc_dec(&fe->refc, 1);
+ */
if (!patch(Addresses, (Uint) fe))
return 0;
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index 26e3054c4b..9d4a60fed1 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -108,6 +108,11 @@ extern Uint erts_total_code_size;
#define MI_ON_LOAD_FUNCTION_PTR 10
/*
+ * Pointer to the line table (or NULL if none).
+ */
+#define MI_LINE_TABLE 11
+
+/*
* Start of function pointer table. This table contains pointers to
* all functions in the module plus an additional pointer just beyond
* the end of the last function.
@@ -116,5 +121,5 @@ extern Uint erts_total_code_size;
* this table.
*/
-#define MI_FUNCTIONS 11
+#define MI_FUNCTIONS 12
#endif /* _BEAM_LOAD_H */
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 98dde066fc..4bfae7e2db 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1107,9 +1107,9 @@ BIF_RETTYPE hibernate_3(BIF_ALIST_3)
/**********************************************************************/
-BIF_RETTYPE get_stacktrace_0(Process* p)
+BIF_RETTYPE get_stacktrace_0(BIF_ALIST_0)
{
- Eterm t = build_stacktrace(p, p->ftrace);
+ Eterm t = build_stacktrace(BIF_P, BIF_P->ftrace);
BIF_RET(t);
}
@@ -1119,10 +1119,10 @@ BIF_RETTYPE get_stacktrace_0(Process* p)
* the process, and the final error value will be {Term,StackTrace}.
*/
-BIF_RETTYPE error_1(Process* p, Eterm term)
+BIF_RETTYPE error_1(BIF_ALIST_1)
{
- p->fvalue = term;
- BIF_ERROR(p, EXC_ERROR);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, EXC_ERROR);
}
/**********************************************************************/
@@ -1131,12 +1131,12 @@ BIF_RETTYPE error_1(Process* p, Eterm term)
* in the stacktrace.
*/
-BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args)
+BIF_RETTYPE error_2(BIF_ALIST_2)
{
- Eterm* hp = HAlloc(p, 3);
+ Eterm* hp = HAlloc(BIF_P, 3);
- p->fvalue = TUPLE2(hp, value, args);
- BIF_ERROR(p, EXC_ERROR_2);
+ BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
+ BIF_ERROR(BIF_P, EXC_ERROR_2);
}
/**********************************************************************/
@@ -1146,10 +1146,10 @@ BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args)
* It is useful in stub functions for NIFs.
*/
-BIF_RETTYPE nif_error_1(Process* p, Eterm term)
+BIF_RETTYPE nif_error_1(BIF_ALIST_1)
{
- p->fvalue = term;
- BIF_ERROR(p, EXC_ERROR);
+ BIF_P->fvalue = BIF_ARG_1;
+ BIF_ERROR(BIF_P, EXC_ERROR);
}
/**********************************************************************/
@@ -1159,12 +1159,12 @@ BIF_RETTYPE nif_error_1(Process* p, Eterm term)
* It is useful in stub functions for NIFs.
*/
-BIF_RETTYPE nif_error_2(Process* p, Eterm value, Eterm args)
+BIF_RETTYPE nif_error_2(BIF_ALIST_2)
{
- Eterm* hp = HAlloc(p, 3);
+ Eterm* hp = HAlloc(BIF_P, 3);
- p->fvalue = TUPLE2(hp, value, args);
- BIF_ERROR(p, EXC_ERROR_2);
+ BIF_P->fvalue = TUPLE2(hp, BIF_ARG_1, BIF_ARG_2);
+ BIF_ERROR(BIF_P, EXC_ERROR_2);
}
/**********************************************************************/
@@ -1183,14 +1183,19 @@ BIF_RETTYPE exit_1(BIF_ALIST_1)
* If there is an error in the argument format,
* return the atom 'badarg' instead.
*/
-Eterm
-raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
+BIF_RETTYPE raise_3(BIF_ALIST_3)
+{
+ Process *c_p = BIF_P;
+ Eterm class = BIF_ARG_1;
+ Eterm value = BIF_ARG_2;
+ Eterm stacktrace = BIF_ARG_3;
Eterm reason;
Eterm l, *hp, *hp_end, *tp;
int depth, cnt;
size_t sz;
+ int must_copy = 0;
struct StackTrace *s;
-
+
if (class == am_error) {
c_p->fvalue = value;
reason = EXC_ERROR;
@@ -1206,35 +1211,74 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
/* Check syntax of stacktrace, and count depth.
* Accept anything that can be returned from erlang:get_stacktrace/0,
* as well as a 2-tuple with a fun as first element that the
- * error_handler may need to give us.
+ * error_handler may need to give us. Also allow old-style
+ * MFA three-tuples.
*/
for (l = stacktrace, depth = 0;
is_list(l);
l = CDR(list_val(l)), depth++) {
Eterm t = CAR(list_val(l));
- int arity;
+ Eterm location = NIL;
+
if (is_not_tuple(t)) goto error;
tp = tuple_val(t);
- arity = arityval(tp[0]);
- if ((arity == 3) && is_atom(tp[1]) && is_atom(tp[2])) continue;
- if ((arity == 2) && is_fun(tp[1])) continue;
- goto error;
+ switch (arityval(tp[0])) {
+ case 2:
+ /* {Fun,Args} */
+ if (is_fun(tp[1])) {
+ must_copy = 1;
+ } else {
+ goto error;
+ }
+ break;
+ case 3:
+ /*
+ * One of:
+ * {Fun,Args,Location}
+ * {M,F,A}
+ */
+ if (is_fun(tp[1])) {
+ location = tp[3];
+ } else if (is_atom(tp[1]) && is_atom(tp[2])) {
+ must_copy = 1;
+ } else {
+ goto error;
+ }
+ break;
+ case 4:
+ if (!(is_atom(tp[1]) && is_atom(tp[2]))) {
+ goto error;
+ }
+ location = tp[4];
+ break;
+ default:
+ goto error;
+ }
+ if (is_not_list(location) && is_not_nil(location)) {
+ goto error;
+ }
}
if (is_not_nil(l)) goto error;
/* Create stacktrace and store */
- if (depth <= erts_backtrace_depth) {
+ if (erts_backtrace_depth < depth) {
+ depth = erts_backtrace_depth;
+ must_copy = 1;
+ }
+ if (must_copy) {
+ cnt = depth;
+ c_p->ftrace = NIL;
+ } else {
+ /* No need to copy the stacktrace */
cnt = 0;
c_p->ftrace = stacktrace;
- } else {
- cnt = depth = erts_backtrace_depth;
- c_p->ftrace = NIL;
}
+
tp = &c_p->ftrace;
sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm) - 1)
/ sizeof(Eterm);
- hp = HAlloc(c_p, sz + 2*(cnt + 1));
- hp_end = hp + sz + 2*(cnt + 1);
+ hp = HAlloc(c_p, sz + (2+6)*(cnt + 1));
+ hp_end = hp + sz + (2+6)*(cnt + 1);
s = (struct StackTrace *) hp;
s->header = make_neg_bignum_header(sz - 1);
s->freason = reason;
@@ -1242,13 +1286,29 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
s->current = NULL;
s->depth = 0;
hp += sz;
- if (cnt > 0) {
+ if (must_copy) {
+ int cnt;
+
/* Copy list up to depth */
for (cnt = 0, l = stacktrace;
cnt < depth;
cnt++, l = CDR(list_val(l))) {
+ Eterm t;
+ Eterm *tpp;
+ int arity;
+
ASSERT(*tp == NIL);
- *tp = CONS(hp, CAR(list_val(l)), *tp);
+ t = CAR(list_val(l));
+ tpp = tuple_val(t);
+ arity = arityval(tpp[0]);
+ if (arity == 2) {
+ t = TUPLE3(hp, tpp[1], tpp[2], NIL);
+ hp += 4;
+ } else if (arity == 3 && is_atom(tpp[1])) {
+ t = TUPLE4(hp, tpp[1], tpp[2], tpp[3], NIL);
+ hp += 5;
+ }
+ *tp = CONS(hp, t, *tp);
tp = &CDR(list_val(*tp));
hp += 2;
}
@@ -1256,7 +1316,7 @@ raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) {
c_p->ftrace = CONS(hp, c_p->ftrace, make_big((Eterm *) s));
hp += 2;
ASSERT(hp <= hp_end);
-
+ HRelease(c_p, hp_end, hp);
BIF_ERROR(c_p, reason);
error:
@@ -1674,10 +1734,10 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1)
* erlang:'!'/2
*/
-Eterm
-ebif_bang_2(Process* p, Eterm To, Eterm Message)
+BIF_RETTYPE
+ebif_bang_2(BIF_ALIST_2)
{
- return send_2(p, To, Message);
+ return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
}
@@ -2014,8 +2074,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) {
}
-Eterm
-send_3(Process *p, Eterm to, Eterm msg, Eterm opts) {
+BIF_RETTYPE send_3(BIF_ALIST_3)
+{
+ Process *p = BIF_P;
+ Eterm to = BIF_ARG_1;
+ Eterm msg = BIF_ARG_2;
+ Eterm opts = BIF_ARG_3;
+
int connect = !0;
int suspend = !0;
Eterm l = opts;
@@ -2079,8 +2144,13 @@ send_3(Process *p, Eterm to, Eterm msg, Eterm opts) {
BIF_ERROR(p, BADARG);
}
-Eterm
-send_2(Process *p, Eterm to, Eterm msg) {
+BIF_RETTYPE send_2(BIF_ALIST_2)
+{
+ return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+Eterm erl_send(Process *p, Eterm to, Eterm msg)
+{
Sint result = do_send(p, to, msg, !0);
if (result > 0) {
@@ -3256,8 +3326,11 @@ time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day,
/* return the universal time */
BIF_RETTYPE
-localtime_to_universaltime_2(Process *p, Eterm localtime, Eterm dst)
+localtime_to_universaltime_2(BIF_ALIST_2)
{
+ Process *p = BIF_P;
+ Eterm localtime = BIF_ARG_1;
+ Eterm dst = BIF_ARG_2;
Sint year, month, day;
Sint hour, minute, second;
int isdst;
@@ -3506,9 +3579,10 @@ BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1)
}
-Eterm
-display_string_1(Process* p, Eterm string)
+BIF_RETTYPE display_string_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm string = BIF_ARG_1;
int len = is_string(string);
char *str;
@@ -3524,8 +3598,7 @@ display_string_1(Process* p, Eterm string)
BIF_RET(am_true);
}
-Eterm
-display_nl_0(Process* p)
+BIF_RETTYPE display_nl_0(BIF_ALIST_0)
{
erts_fprintf(stderr, "\n");
BIF_RET(am_true);
@@ -3589,8 +3662,13 @@ BIF_RETTYPE function_exported_3(BIF_ALIST_3)
/**********************************************************************/
-BIF_RETTYPE is_builtin_3(Process* p, Eterm Mod, Eterm Name, Eterm Arity)
+BIF_RETTYPE is_builtin_3(BIF_ALIST_3)
{
+ Process* p = BIF_P;
+ Eterm Mod = BIF_ARG_1;
+ Eterm Name = BIF_ARG_2;
+ Eterm Arity = BIF_ARG_3;
+
if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) {
BIF_ERROR(p, BADARG);
}
@@ -3655,9 +3733,11 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3)
BIF_RET(make_export(hp));
}
-Eterm
-fun_to_list_1(Process* p, Eterm fun)
+BIF_RETTYPE fun_to_list_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm fun = BIF_ARG_1;
+
if (is_not_any_fun(fun))
BIF_ERROR(p, BADARG);
BIF_RET(term2list_dsprintf(p, fun));
@@ -3995,7 +4075,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
erts_backtrace_depth = n;
BIF_RET(make_small(oval));
} else if (BIF_ARG_1 == am_trace_control_word) {
- BIF_RET(db_set_trace_control_word_1(BIF_P, BIF_ARG_2));
+ BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2));
} else if (BIF_ARG_1 == am_sequential_tracer) {
Eterm old_value = erts_set_system_seq_tracer(BIF_P,
ERTS_PROC_LOCK_MAIN,
@@ -4235,8 +4315,7 @@ void
erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret)
{
if (skip_current_msgq(c_p)) {
- Eterm unused;
- ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret);
+ ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret);
}
}
@@ -4244,8 +4323,7 @@ void
erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid)
{
if (skip_current_msgq(c_p)) {
- Eterm unused;
- ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p,
+ ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p,
pid, am_reason, am_undefined);
}
}
@@ -4260,7 +4338,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
{
ASSERT(is_atom(module) && is_atom(function));
if (skip_current_msgq(c_p)) {
- Eterm unused;
Eterm term;
Eterm *hp;
int i;
@@ -4272,7 +4349,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
hp += 2;
}
term = TUPLE3(hp, module, function, term);
- ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term);
+ ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term);
}
}
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index 8faa09feb8..d20089a9fb 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -26,14 +26,14 @@ extern Export* erts_format_cpu_topology_trap;
#define BIF_P A__p
-#define BIF_ALIST_0 Process* A__p
-#define BIF_ALIST_1 Process* A__p, Eterm A_1
-#define BIF_ALIST_2 Process* A__p, Eterm A_1, Eterm A_2
-#define BIF_ALIST_3 Process* A__p, Eterm A_1, Eterm A_2, Eterm A_3
+#define BIF_ALIST_0 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST_1 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST_2 Process* A__p, Eterm* BIF__ARGS
+#define BIF_ALIST_3 Process* A__p, Eterm* BIF__ARGS
-#define BIF_ARG_1 A_1
-#define BIF_ARG_2 A_2
-#define BIF_ARG_3 A_3
+#define BIF_ARG_1 (BIF__ARGS[0])
+#define BIF_ARG_2 (BIF__ARGS[1])
+#define BIF_ARG_3 (BIF__ARGS[2])
#define BUMP_ALL_REDS(p) do { \
if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \
@@ -122,89 +122,106 @@ do { \
} while (0)
-#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \
-do { \
- (Proc)->arity = 0; \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
- (Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
+#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \
+do { \
+ (Proc)->arity = 0; \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
} while (0)
-#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \
-do { \
- (Proc)->arity = 1; \
- (Proc)->def_arg_reg[0] = (Eterm) (A0); \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
- (Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
+#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->arity = 1; \
+ reg[0] = (Eterm) (A0); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
} while (0)
-#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \
-do { \
- (Proc)->arity = 2; \
- (Proc)->def_arg_reg[0] = (Eterm) (A0); \
- (Proc)->def_arg_reg[1] = (Eterm) (A1); \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
- (Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
+#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->arity = 2; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
+} while (0)
+
+#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2) \
+do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
+ (Proc)->arity = 3; \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
+ (Proc)->freason = TRAP; \
+ (Ret) = THE_NON_VALUE; \
} while (0)
-#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2)\
+#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\
do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((Proc))->x_reg_array; \
(Proc)->arity = 3; \
- (Proc)->def_arg_reg[0] = (Eterm) (A0); \
- (Proc)->def_arg_reg[1] = (Eterm) (A1); \
- (Proc)->def_arg_reg[2] = (Eterm) (A2); \
- *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \
+ reg[0] = (Eterm) (A0); \
+ reg[1] = (Eterm) (A1); \
+ reg[2] = (Eterm) (A2); \
+ (Proc)->i = (BeamInstr*) ((Trap)->address); \
(Proc)->freason = TRAP; \
- (Ret) = THE_NON_VALUE; \
} while (0)
-#define BIF_TRAP0(p, Trap_) do { \
- (p)->arity = 0; \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP0(p, Trap_) do { \
+ (p)->arity = 0; \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP1(Trap_, p, A0) do { \
- (p)->arity = 1; \
- (p)->def_arg_reg[0] = (A0); \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP1(Trap_, p, A0) do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ (p)->arity = 1; \
+ reg[0] = (A0); \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP2(Trap_, p, A0, A1) do { \
- (p)->arity = 2; \
- (p)->def_arg_reg[0] = (A0); \
- (p)->def_arg_reg[1] = (A1); \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP2(Trap_, p, A0, A1) do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ (p)->arity = 2; \
+ reg[0] = (A0); \
+ reg[1] = (A1); \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \
- (p)->arity = 3; \
- (p)->def_arg_reg[0] = (A0); \
- (p)->def_arg_reg[1] = (A1); \
- (p)->def_arg_reg[2] = (A2); \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \
+ Eterm* reg = ERTS_PROC_GET_SCHDATA((p))->x_reg_array; \
+ (p)->arity = 3; \
+ reg[0] = (A0); \
+ reg[1] = (A1); \
+ reg[2] = (A2); \
+ (p)->i = (BeamInstr*) ((Trap_)->address); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \
- (p)->arity = 0; \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \
+ (p)->arity = 0; \
+ (p)->i = (BeamInstr*) (Code_); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
-#define BIF_TRAP_CODE_PTR_(p, Code_) do { \
- *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) (Code_); \
- (p)->freason = TRAP; \
- return THE_NON_VALUE; \
+#define BIF_TRAP_CODE_PTR_(p, Code_) do { \
+ (p)-> i = (BeamInstr*) (Code_); \
+ (p)->freason = TRAP; \
+ return THE_NON_VALUE; \
} while(0)
extern Export bif_return_trap_export;
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index d18de9ae5d..b90ea6b478 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -1584,6 +1584,62 @@ big_to_double(Wterm x, double* resp)
return 0;
}
+/*
+ * Logic has been copied from erl_bif_guard.c and slightly
+ * modified to use a static instead of dynamic heap
+ */
+Eterm
+double_to_big(double x, Eterm *heap)
+{
+ int is_negative;
+ int ds;
+ ErtsDigit* xp;
+ Eterm res;
+ int i;
+ size_t sz;
+ Eterm* hp;
+ double dbase;
+
+ if (x >= 0) {
+ is_negative = 0;
+ } else {
+ is_negative = 1;
+ x = -x;
+ }
+
+ /* Unscale & (calculate exponent) */
+ ds = 0;
+ dbase = ((double) (D_MASK) + 1);
+ while (x >= 1.0) {
+ x /= dbase; /* "shift" right */
+ ds++;
+ }
+ sz = BIG_NEED_SIZE(ds); /* number of words including arity */
+
+ hp = heap;
+ res = make_big(hp);
+ xp = (ErtsDigit*) (hp + 1);
+
+ for (i = ds - 1; i >= 0; i--) {
+ ErtsDigit d;
+
+ x *= dbase; /* "shift" left */
+ d = x; /* trunc */
+ xp[i] = d; /* store digit */
+ x -= d; /* remove integer part */
+ }
+ while ((ds & (BIG_DIGITS_PER_WORD - 1)) != 0) {
+ xp[ds++] = 0;
+ }
+
+ if (is_negative) {
+ *hp = make_neg_bignum_header(sz-1);
+ } else {
+ *hp = make_pos_bignum_header(sz-1);
+ }
+ return res;
+}
+
/*
** Estimate the number of decimal digits (include sign)
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index 2afc37004f..256f1c2b45 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -140,6 +140,7 @@ Eterm big_lshift(Eterm, Sint, Eterm*);
int big_comp (Wterm, Wterm);
int big_ucomp (Eterm, Eterm);
int big_to_double(Wterm x, double* resp);
+Eterm double_to_big(double, Eterm*);
Eterm small_to_big(Sint, Eterm*);
Eterm uint_to_big(Uint, Eterm*);
Eterm uword_to_big(UWord, Eterm*);
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index 1fb39c6c67..29461877c5 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -356,8 +356,10 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
{
Eterm bin;
Uint size;
- int offset;
byte* bytes;
+#ifdef DEBUG
+ int offset;
+#endif
if (is_nil(arg)) {
BIF_RET(new_binary(p,(byte*)"",0));
@@ -372,7 +374,11 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
}
bin = new_binary(p, (byte *)NULL, size);
bytes = binary_bytes(bin);
- offset = io_list_to_buf(arg, (char*) bytes, size);
+#ifdef DEBUG
+ offset =
+#endif
+ io_list_to_buf(arg, (char*) bytes, size);
+
ASSERT(offset == 0);
BIF_RET(bin);
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 432b3d0780..8132bbeaa1 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -94,7 +94,7 @@ process_killer(void)
erts_printf("(k)ill (n)ext (r)eturn:\n");
while(1) {
if ((j = sys_get_key(0)) <= 0)
- halt_0(0);
+ erl_exit(0, "");
switch(j) {
case 'k':
if (rp->status == P_WAITING) {
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index ad042ec088..29b83520dd 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -2730,85 +2730,92 @@ BIF_RETTYPE is_alive_0(BIF_ALIST_0)
/**********************************************************************/
/* erlang:monitor_node(Node, Bool, Options) -> Bool */
-BIF_RETTYPE monitor_node_3(BIF_ALIST_3)
+static BIF_RETTYPE
+monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options)
{
DistEntry *dep;
ErtsLink *lnk;
Eterm l;
- for (l = BIF_ARG_3; l != NIL && is_list(l); l = CDR(list_val(l))) {
+ for (l = Options; l != NIL && is_list(l); l = CDR(list_val(l))) {
Eterm t = CAR(list_val(l));
/* allow_passive_connect the only available option right now */
if (t != am_allow_passive_connect) {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
}
if (l != NIL) {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- if (is_not_atom(BIF_ARG_1) ||
- ((BIF_ARG_2 != am_true) && (BIF_ARG_2 != am_false)) ||
+ if (is_not_atom(Node) ||
+ ((Bool != am_true) && (Bool != am_false)) ||
((erts_this_node->sysname == am_Noname)
- && (BIF_ARG_1 != erts_this_node->sysname))) {
- BIF_ERROR(BIF_P, BADARG);
+ && (Node != erts_this_node->sysname))) {
+ BIF_ERROR(p, BADARG);
}
- dep = erts_sysname_to_connected_dist_entry(BIF_ARG_1);
+ dep = erts_sysname_to_connected_dist_entry(Node);
if (!dep) {
do_trap:
- BIF_TRAP3(dmonitor_node_trap, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ BIF_TRAP3(dmonitor_node_trap, p, Node, Bool, Options);
}
if (dep == erts_this_dist_entry)
goto done;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK);
erts_smp_de_rlock(dep);
if (ERTS_DE_IS_NOT_CONNECTED(dep)) {
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
erts_smp_de_runlock(dep);
goto do_trap;
}
erts_smp_de_links_lock(dep);
erts_smp_de_runlock(dep);
- if (BIF_ARG_2 == am_true) {
+ if (Bool == am_true) {
ASSERT(dep->cid != NIL);
lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE,
- BIF_P->id);
+ p->id);
++ERTS_LINK_REFC(lnk);
- lnk = erts_add_or_lookup_link(&(BIF_P->nlinks), LINK_NODE, BIF_ARG_1);
+ lnk = erts_add_or_lookup_link(&(p->nlinks), LINK_NODE, Node);
++ERTS_LINK_REFC(lnk);
}
else {
- lnk = erts_lookup_link(dep->node_links, BIF_P->id);
+ lnk = erts_lookup_link(dep->node_links, p->id);
if (lnk != NULL) {
if ((--ERTS_LINK_REFC(lnk)) == 0) {
erts_destroy_link(erts_remove_link(&(dep->node_links),
- BIF_P->id));
+ p->id));
}
}
- lnk = erts_lookup_link(BIF_P->nlinks, BIF_ARG_1);
+ lnk = erts_lookup_link(p->nlinks, Node);
if (lnk != NULL) {
if ((--ERTS_LINK_REFC(lnk)) == 0) {
- erts_destroy_link(erts_remove_link(&(BIF_P->nlinks),
- BIF_ARG_1));
+ erts_destroy_link(erts_remove_link(&(p->nlinks),
+ Node));
}
}
}
erts_smp_de_links_unlock(dep);
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK);
done:
erts_deref_dist_entry(dep);
BIF_RET(am_true);
}
+BIF_RETTYPE monitor_node_3(BIF_ALIST_3)
+{
+ BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3));
+}
+
+
/* monitor_node(Node, Bool) -> Bool */
BIF_RETTYPE monitor_node_2(BIF_ALIST_2)
{
- BIF_RET(monitor_node_3(BIF_P,BIF_ARG_1,BIF_ARG_2,NIL));
+ BIF_RET(monitor_node(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL));
}
BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1)
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index 64fad9fe0e..5150a8a507 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -164,14 +164,14 @@ BIF_RETTYPE bxor_2(BIF_ALIST_2)
BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2));
}
-BIF_RETTYPE bsl_2(Process* p, Eterm arg1, Eterm arg2)
+BIF_RETTYPE bsl_2(BIF_ALIST_2)
{
- BIF_RET(shift(p, arg1, arg2, 0));
+ BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 0));
}
-BIF_RETTYPE bsr_2(Process* p, Eterm arg1, Eterm arg2)
+BIF_RETTYPE bsr_2(BIF_ALIST_2)
{
- BIF_RET(shift(p, arg1, arg2, 1));
+ BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 1));
}
static Eterm
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 684fa5d12f..6d022e0d11 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -65,6 +65,10 @@ static Export binary_copy_trap_export;
static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
static Uint max_loop_limit;
+static BIF_RETTYPE
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+static BIF_RETTYPE
+binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
void erts_init_bif_binary(void)
{
@@ -1399,6 +1403,12 @@ static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3)
BIF_RETTYPE binary_match_3(BIF_ALIST_3)
{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
Uint hsstart;
Uint hsend;
Eterm *tp;
@@ -1408,17 +1418,17 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
int runres;
Eterm result;
- if (is_not_binary(BIF_ARG_1)) {
+ if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) {
+ if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
goto badarg;
}
if (hsend == 0) {
BIF_RET(am_nomatch);
}
- if (is_tuple(BIF_ARG_2)) {
- tp = tuple_val(BIF_ARG_2);
+ if (is_tuple(arg2)) {
+ tp = tuple_val(arg2);
if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
goto badarg;
}
@@ -1437,13 +1447,13 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2,&type,&bin)) {
goto badarg;
}
- runres = do_binary_match(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,NIL,&result);
+ runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
- Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin);
+ Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
+ bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
@@ -1451,17 +1461,23 @@ BIF_RETTYPE binary_match_3(BIF_ALIST_3)
case DO_BIN_MATCH_OK:
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, bin_term);
+ BUMP_ALL_REDS(p);
+ BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term);
default:
goto badarg;
}
badarg:
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
{
+ return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
Uint hsstart, hsend;
Eterm *tp;
Eterm type;
@@ -1470,17 +1486,17 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
int runres;
Eterm result;
- if (is_not_binary(BIF_ARG_1)) {
+ if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) {
+ if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
goto badarg;
}
if (hsend == 0) {
BIF_RET(NIL);
}
- if (is_tuple(BIF_ARG_2)) {
- tp = tuple_val(BIF_ARG_2);
+ if (is_tuple(arg2)) {
+ tp = tuple_val(arg2);
if (arityval(*tp) != 2 || is_not_atom(tp[1])) {
goto badarg;
}
@@ -1499,14 +1515,14 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2,&type,&bin)) {
goto badarg;
}
- runres = do_binary_matches(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,
+ runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin,
NIL,&result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
- Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin);
+ Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
+ bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
@@ -1514,26 +1530,26 @@ BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
case DO_BIN_MATCH_OK:
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result,
+ BUMP_ALL_REDS(p);
+ BIF_TRAP3(&binary_matches_trap_export, p, arg1, result,
bin_term);
default:
goto badarg;
}
badarg:
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
BIF_RETTYPE binary_match_2(BIF_ALIST_2)
{
- return binary_match_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
}
BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
{
- return binary_matches_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
}
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index d714eacd06..a9fd28c66b 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -142,9 +142,11 @@ static void ddll_no_more_references(void *vdh);
* really load and add as LOADED {ok,loaded} {ok,pending_driver}
* {error, permanent} {error,load_error()}
*/
-BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
- Eterm name_term, Eterm options)
+BIF_RETTYPE erl_ddll_try_load_3(BIF_ALIST_3)
{
+ Eterm path_term = BIF_ARG_1;
+ Eterm name_term = BIF_ARG_2;
+ Eterm options = BIF_ARG_3;
char *path = NULL;
Uint path_len;
char *name = NULL;
@@ -236,7 +238,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
sys_strcpy(path+path_len,name);
#if DDLL_SMP
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
#endif
if ((drv = lookup_driver(name)) != NULL) {
@@ -247,7 +249,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
} else {
dh = drv->handle;
if (dh->status == ERL_DE_OK) {
- int is_last = is_last_user(dh,p);
+ int is_last = is_last_user(dh, BIF_P);
if (reload == 1 && !is_last) {
/*Want reload if no other users,
but there are others...*/
@@ -261,7 +263,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
soft_error_term = am_inconsistent;
goto soft_error;
}
- if ((old = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) ==
+ if ((old = find_proc_entry(dh, BIF_P,
+ ERL_DE_PROC_LOADED)) ==
NULL) {
soft_error_term = am_not_loaded_by_this_process;
goto soft_error;
@@ -272,7 +275,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
}
/* Reload requested and granted */
dereference_all_processes(dh);
- set_driver_reloading(dh, p, path, name, flags);
+ set_driver_reloading(dh, BIF_P, path, name, flags);
if (dh->flags & ERL_DE_FL_KILL_PORTS) {
kill_ports = 1;
}
@@ -286,7 +289,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
soft_error_term = am_inconsistent;
goto soft_error;
}
- add_proc_loaded(dh,p);
+ add_proc_loaded(dh, BIF_P);
erts_ddll_reference_driver(dh);
monitor = 0;
ok_term = mkatom("already_loaded");
@@ -308,7 +311,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
notify_all(dh, drv->name,
ERL_DE_PROC_AWAIT_UNLOAD, am_UP,
am_unload_cancelled);
- add_proc_loaded(dh,p);
+ add_proc_loaded(dh, BIF_P);
erts_ddll_reference_driver(dh);
monitor = 0;
ok_term = mkatom("already_loaded");
@@ -325,7 +328,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
goto soft_error;
}
/* Load of granted unload... */
- add_proc_loaded_deref(dh,p); /* Dont reference, will happen after reload */
+ /* Don't reference, will happen after reload */
+ add_proc_loaded_deref(dh, BIF_P);
++monitor;
ok_term = am_pending_driver;
} else { /* ERL_DE_PERMANENT */
@@ -345,7 +349,7 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
goto soft_error;
} else {
dh->flags = flags;
- add_proc_loaded(dh,p);
+ add_proc_loaded(dh, BIF_P);
first_ddll_reference(dh);
monitor = 0;
ok_term = mkatom("loaded");
@@ -397,18 +401,18 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
#if DDLL_SMP
erts_ddll_reference_driver(dh);
unlock_drv_list();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
erts_ddll_dereference_driver(dh);
#endif
- p->flags |= F_USING_DDLL;
+ BIF_P->flags |= F_USING_DDLL;
if (monitor) {
- Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_LOAD);
- hp = HAlloc(p,4);
+ Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_LOAD);
+ hp = HAlloc(BIF_P, 4);
t = TUPLE3(hp, am_ok, ok_term, mref);
} else {
- hp = HAlloc(p,3);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_ok, ok_term);
}
#if DDLL_SMP
@@ -416,33 +420,33 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
BIF_RET(t);
soft_error:
#if DDLL_SMP
unlock_drv_list();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
#endif
if (do_build_load_error) {
- soft_error_term = build_load_error(p, build_this_load_error);
+ soft_error_term = build_load_error(BIF_P, build_this_load_error);
}
- hp = HAlloc(p,3);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_error, soft_error_term);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
BIF_RET(t);
error:
assert_drv_list_not_locked();
- ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(BIF_P));
if (path != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path);
}
if (name != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
}
- BIF_ERROR(p,BADARG);
+ BIF_ERROR(BIF_P, BADARG);
}
/*
@@ -481,8 +485,10 @@ BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term,
any AWAIT_LOAD-waiters with {'DOWN', ref(), driver, name(), load_cancelled}
If the driver made itself permanent, {'UP', ref(), driver, name(), permanent}
*/
-Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options)
+Eterm erl_ddll_try_unload_2(BIF_ALIST_2)
{
+ Eterm name_term = BIF_ARG_1;
+ Eterm options = BIF_ARG_2;
char *name = NULL;
Eterm ok_term = NIL;
Eterm soft_error_term = NIL;
@@ -495,7 +501,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options)
Eterm l;
int kill_ports = 0;
- erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
for(l = options; is_list(l); l = CDR(list_val(l))) {
Eterm opt = CAR(list_val(l));
@@ -548,7 +554,7 @@ Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options)
if (dh->flags & ERL_DE_FL_KILL_PORTS) {
kill_ports = 1;
}
- if ((pe = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == NULL) {
+ if ((pe = find_proc_entry(dh, BIF_P, ERL_DE_PROC_LOADED)) == NULL) {
if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) {
soft_error_term = am_not_loaded_by_this_process;
goto soft_error;
@@ -624,22 +630,22 @@ done:
#if DDLL_SMP
erts_ddll_reference_driver(dh);
unlock_drv_list();
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
lock_drv_list();
erts_ddll_dereference_driver(dh);
#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- p->flags |= F_USING_DDLL;
+ BIF_P->flags |= F_USING_DDLL;
if (monitor > 0) {
- Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_UNLOAD);
- hp = HAlloc(p,4);
+ Eterm mref = add_monitor(BIF_P, dh, ERL_DE_PROC_AWAIT_UNLOAD);
+ hp = HAlloc(BIF_P, 4);
t = TUPLE3(hp, am_ok, ok_term, mref);
} else {
- hp = HAlloc(p,3);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_ok, ok_term);
}
if (kill_ports > 1) {
- ERTS_BIF_CHK_EXITED(p); /* May be exited by port killing */
+ ERTS_BIF_CHK_EXITED(BIF_P); /* May be exited by port killing */
}
#if DDLL_SMP
unlock_drv_list();
@@ -651,8 +657,8 @@ soft_error:
unlock_drv_list();
#endif
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- hp = HAlloc(p,3);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ hp = HAlloc(BIF_P, 3);
t = TUPLE2(hp, am_error, soft_error_term);
BIF_RET(t);
@@ -661,21 +667,21 @@ soft_error:
if (name != NULL) {
erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
}
- erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
- BIF_ERROR(p,BADARG);
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ BIF_ERROR(BIF_P, BADARG);
}
/*
* A shadow of the "real" demonitor BIF
*/
-BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref)
+BIF_RETTYPE erl_ddll_demonitor_1(BIF_ALIST_1)
{
- if (is_not_internal_ref(ref)) {
- BIF_ERROR(p, BADARG);
+ if (is_not_internal_ref(BIF_ARG_1)) {
+ BIF_ERROR(BIF_P, BADARG);
}
- if (p->flags & F_USING_DDLL) {
- erts_ddll_remove_monitor(p, ref, ERTS_PROC_LOCK_MAIN);
+ if (BIF_P->flags & F_USING_DDLL) {
+ erts_ddll_remove_monitor(BIF_P, BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
}
BIF_RET(am_true);
}
@@ -683,18 +689,18 @@ BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref)
/*
* A shadow of the "real" monitor BIF
*/
-BIF_RETTYPE erl_ddll_monitor_2(Process *p, Eterm dr, Eterm what)
+BIF_RETTYPE erl_ddll_monitor_2(BIF_ALIST_2)
{
- if (dr != am_driver) {
- BIF_ERROR(p,BADARG);
+ if (BIF_ARG_1 != am_driver) {
+ BIF_ERROR(BIF_P, BADARG);
}
- return erts_ddll_monitor_driver(p, what, ERTS_PROC_LOCK_MAIN);
+ return erts_ddll_monitor_driver(BIF_P, BIF_ARG_2, ERTS_PROC_LOCK_MAIN);
}
/*
* Return list of loaded drivers {ok,[string()]}
*/
-Eterm erl_ddll_loaded_drivers_0(Process *p)
+BIF_RETTYPE erl_ddll_loaded_drivers_0(BIF_ALIST_0)
{
Eterm *hp;
int need = 3;
@@ -706,7 +712,7 @@ Eterm erl_ddll_loaded_drivers_0(Process *p)
for (drv = driver_list; drv; drv = drv->next) {
need += sys_strlen(drv->name)*2+2;
}
- hp = HAlloc(p,need);
+ hp = HAlloc(BIF_P, need);
for (drv = driver_list; drv; drv = drv->next) {
Eterm l;
l = buf_to_intlist(&hp, drv->name, sys_strlen(drv->name), NIL);
@@ -726,8 +732,11 @@ Eterm erl_ddll_loaded_drivers_0(Process *p)
* item is processes, driver_options, port_count, linked_in_driver,
* permanent, awaiting_load, awaiting_unload
*/
-Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item)
+BIF_RETTYPE erl_ddll_info_2(BIF_ALIST_2)
{
+ Process *p = BIF_P;
+ Eterm name_term = BIF_ARG_1;
+ Eterm item = BIF_ARG_2;
char *name = NULL;
Eterm res = NIL;
erts_driver_t *drv;
@@ -850,8 +859,10 @@ Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item)
* Backend for erl_ddll:format_error, handles all "soft" errors returned by builtins,
* possibly by calling the system specific error handler
*/
-Eterm erl_ddll_format_error_int_1(Process *p, Eterm code_term)
+BIF_RETTYPE erl_ddll_format_error_int_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm code_term = BIF_ARG_1;
char *errstring = NULL;
int errint;
int len;
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 70d728340a..729a7c7648 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -122,6 +122,16 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE
# define PERFMON_GETPCR _IOR('P', 2, unsigned long long)
#endif
+/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */
+static Eterm os_type_tuple;
+static Eterm os_version_tuple;
+
+static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item);
+
+static Eterm
+current_function(Process* p, Process* rp, Eterm** hpp, int full_info);
+static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp);
+
static Eterm
bld_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
{
@@ -557,6 +567,8 @@ static Eterm pi_args[] = {
am_suspending,
am_min_heap_size,
am_min_bin_vheap_size,
+ am_current_location,
+ am_current_stacktrace,
#ifdef HYBRID
am_message_binary
#endif
@@ -605,8 +617,10 @@ pi_arg2ix(Eterm arg)
case am_suspending: return 26;
case am_min_heap_size: return 27;
case am_min_bin_vheap_size: return 28;
+ case am_current_location: return 29;
+ case am_current_stacktrace: return 30;
#ifdef HYBRID
- case am_message_binary: return 29;
+ case am_message_binary: return 31;
#endif
default: return -1;
}
@@ -1009,35 +1023,15 @@ process_info_aux(Process *BIF_P,
break;
case am_current_function:
- if (rp->current == NULL) {
- rp->current = find_function_from_pc(rp->i);
- }
- if (rp->current == NULL) {
- hp = HAlloc(BIF_P, 3);
- res = am_undefined;
- } else {
- BeamInstr* current;
-
- if (rp->current[0] == am_erlang &&
- rp->current[1] == am_process_info &&
- (rp->current[2] == 1 || rp->current[2] == 2) &&
- (current = find_function_from_pc(rp->cp)) != NULL) {
-
- /*
- * The current function is erlang:process_info/2,
- * which is not the answer that the application want.
- * We will use the function pointed into by rp->cp
- * instead.
- */
+ res = current_function(BIF_P, rp, &hp, 0);
+ break;
- rp->current = current;
- }
+ case am_current_location:
+ res = current_function(BIF_P, rp, &hp, 1);
+ break;
- hp = HAlloc(BIF_P, 3+4);
- res = TUPLE3(hp, rp->current[0],
- rp->current[1], make_small(rp->current[2]));
- hp += 4;
- }
+ case am_current_stacktrace:
+ res = current_stacktrace(BIF_P, rp, &hp);
break;
case am_initial_call:
@@ -1611,6 +1605,113 @@ process_info_aux(Process *BIF_P,
}
#undef MI_INC
+static Eterm
+current_function(Process* BIF_P, Process* rp, Eterm** hpp, int full_info)
+{
+ Eterm* hp;
+ Eterm res;
+ FunctionInfo fi;
+
+ if (rp->current == NULL) {
+ erts_lookup_function_info(&fi, rp->i, full_info);
+ rp->current = fi.current;
+ } else if (full_info) {
+ erts_lookup_function_info(&fi, rp->i, full_info);
+ if (fi.current == NULL) {
+ /* Use the current function without location info */
+ erts_set_current_function(&fi, rp->current);
+ }
+ }
+
+ if (BIF_P->id == rp->id) {
+ FunctionInfo fi2;
+
+ /*
+ * The current function is erlang:process_info/{1,2},
+ * which is not the answer that the application want.
+ * We will use the function pointed into by rp->cp
+ * instead if it can be looked up.
+ */
+ erts_lookup_function_info(&fi2, rp->cp, full_info);
+ if (fi2.current) {
+ fi = fi2;
+ rp->current = fi2.current;
+ }
+ }
+
+ /*
+ * Return the result.
+ */
+ if (rp->current == NULL) {
+ hp = HAlloc(BIF_P, 3);
+ res = am_undefined;
+ } else if (full_info) {
+ hp = HAlloc(BIF_P, 3+fi.needed);
+ hp = erts_build_mfa_item(&fi, hp, am_true, &res);
+ } else {
+ hp = HAlloc(BIF_P, 3+4);
+ res = TUPLE3(hp, rp->current[0],
+ rp->current[1], make_small(rp->current[2]));
+ hp += 4;
+ }
+ *hpp = hp;
+ return res;
+}
+
+static Eterm
+current_stacktrace(Process* p, Process* rp, Eterm** hpp)
+{
+ Uint sz;
+ struct StackTrace* s;
+ int depth;
+ FunctionInfo* stk;
+ FunctionInfo* stkp;
+ Uint heap_size;
+ int i;
+ Eterm* hp = *hpp;
+ Eterm mfa;
+ Eterm res = NIL;
+
+ depth = 8;
+ sz = offsetof(struct StackTrace, trace) + sizeof(BeamInstr *)*depth;
+ s = (struct StackTrace *) erts_alloc(ERTS_ALC_T_TMP, sz);
+ s->depth = 0;
+ if (rp->i) {
+ s->trace[s->depth++] = rp->i;
+ depth--;
+ }
+ if (depth > 0 && rp->cp != 0) {
+ s->trace[s->depth++] = rp->cp - 1;
+ depth--;
+ }
+ erts_save_stacktrace(rp, s, depth);
+
+ depth = s->depth;
+ stk = stkp = (FunctionInfo *) erts_alloc(ERTS_ALC_T_TMP,
+ depth*sizeof(FunctionInfo));
+ heap_size = 3;
+ for (i = 0; i < depth; i++) {
+ erts_lookup_function_info(stkp, s->trace[i], 1);
+ if (stkp->current) {
+ heap_size += stkp->needed + 2;
+ stkp++;
+ }
+ }
+
+ hp = HAlloc(p, heap_size);
+ while (stkp > stk) {
+ stkp--;
+ hp = erts_build_mfa_item(stkp, hp, am_true, &mfa);
+ res = CONS(hp, mfa, res);
+ hp += 2;
+ }
+
+ erts_free(ERTS_ALC_T_TMP, stk);
+ erts_free(ERTS_ALC_T_TMP, s);
+ *hpp = hp;
+ return res;
+}
+
#if defined(VALGRIND)
static int check_if_xml(void)
{
@@ -2027,7 +2128,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_undefined);
#endif
} else if (BIF_ARG_1 == am_trace_control_word) {
- BIF_RET(db_get_trace_control_word_0(BIF_P));
+ BIF_RET(db_get_trace_control_word(BIF_P));
} else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) {
BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false);
} else if (ERTS_IS_ATOM_STR("ets_always_compress", BIF_ARG_1)) {
@@ -2154,16 +2255,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
return erts_instr_get_type_info(BIF_P);
}
else if (BIF_ARG_1 == am_os_type) {
- Eterm type = am_atom_put(os_type, strlen(os_type));
- Eterm flav, tup;
- char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
-
- os_flavor(buf, 1024);
- flav = am_atom_put(buf, strlen(buf));
- hp = HAlloc(BIF_P, 3);
- tup = TUPLE2(hp, type, flav);
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- BIF_RET(tup);
+ BIF_RET(os_type_tuple);
}
else if (BIF_ARG_1 == am_allocator) {
BIF_RET(erts_allocator_options((void *) BIF_P));
@@ -2189,16 +2281,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_false);
}
else if (BIF_ARG_1 == am_os_version) {
- int major, minor, build;
- Eterm tup;
-
- os_version(&major, &minor, &build);
- hp = HAlloc(BIF_P, 4);
- tup = TUPLE3(hp,
- make_small(major),
- make_small(minor),
- make_small(build));
- BIF_RET(tup);
+ BIF_RET(os_version_tuple);
}
else if (BIF_ARG_1 == am_version) {
int n = strlen(ERLANG_VERSION);
@@ -2646,9 +2729,11 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
-Eterm
-port_info_1(Process* p, Eterm pid)
+BIF_RETTYPE
+port_info_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm pid = BIF_ARG_1;
static Eterm keys[] = {
am_name,
am_links,
@@ -2671,7 +2756,7 @@ port_info_1(Process* p, Eterm pid)
for (i = 0; i < ASIZE(keys); i++) {
Eterm item;
- item = port_info_2(p, pid, keys[i]);
+ item = port_info(p, pid, keys[i]);
if (is_non_value(item)) {
return THE_NON_VALUE;
}
@@ -2680,7 +2765,7 @@ port_info_1(Process* p, Eterm pid)
}
items[i] = item;
}
- reg_name = port_info_2(p, pid, am_registered_name);
+ reg_name = port_info(p, pid, am_registered_name);
/*
* Build the resulting list.
@@ -2716,24 +2801,27 @@ port_info_1(Process* p, Eterm pid)
BIF_RETTYPE port_info_2(BIF_ALIST_2)
{
+ return port_info(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE port_info(Process* p, Eterm portid, Eterm item)
+{
BIF_RETTYPE ret;
- Eterm portid = BIF_ARG_1;
Port *prt;
- Eterm item = BIF_ARG_2;
Eterm res;
Eterm* hp;
int count;
if (is_internal_port(portid))
- prt = erts_id2port(portid, BIF_P, ERTS_PROC_LOCK_MAIN);
+ prt = erts_id2port(portid, p, ERTS_PROC_LOCK_MAIN);
else if (is_atom(portid))
- erts_whereis_name(BIF_P, ERTS_PROC_LOCK_MAIN,
+ erts_whereis_name(p, ERTS_PROC_LOCK_MAIN,
portid, NULL, 0, 0, &prt);
else if (is_external_port(portid)
&& external_port_dist_entry(portid) == erts_this_dist_entry)
BIF_RET(am_undefined);
else {
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
if (!prt) {
@@ -2741,7 +2829,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
}
if (item == am_id) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = make_small(internal_port_number(portid));
}
else if (item == am_links) {
@@ -2753,10 +2841,10 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_links(prt->nlinks, &collect_one_link, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ hp = HAlloc(p, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity);
res = CONS(hp, item, res);
hp += 2;
}
@@ -2772,11 +2860,11 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
erts_doforall_monitors(prt->monitors, &collect_one_origin_monitor, &mic);
- hp = HAlloc(BIF_P, 3 + mic.sz);
+ hp = HAlloc(p, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
Eterm t;
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(p), mic.mi[i].entity);
t = TUPLE2(hp, am_process, item);
hp += 3;
res = CONS(hp, t, res);
@@ -2788,25 +2876,25 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
else if (item == am_name) {
count = sys_strlen(prt->name);
- hp = HAlloc(BIF_P, 3 + 2*count);
+ hp = HAlloc(p, 3 + 2*count);
res = buf_to_intlist(&hp, prt->name, count, NIL);
}
else if (item == am_connected) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = prt->connected; /* internal pid */
}
else if (item == am_input) {
Uint hsz = 3;
Uint n = prt->bytes_in;
(void) erts_bld_uint(NULL, &hsz, n);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, n);
}
else if (item == am_output) {
Uint hsz = 3;
Uint n = prt->bytes_out;
(void) erts_bld_uint(NULL, &hsz, n);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, n);
}
else if (item == am_registered_name) {
@@ -2816,7 +2904,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
ERTS_BIF_PREP_RET(ret, NIL);
goto done;
} else {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = reg->name;
}
}
@@ -2828,7 +2916,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
Uint size = 0;
ErlHeapFragment* bp;
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
erts_doforall_links(prt->nlinks, &one_link_size, &size);
@@ -2845,18 +2933,18 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
hard to retrieve... */
(void) erts_bld_uint(NULL, &hsz, size);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, size);
}
else if (item == am_queue_size) {
Uint ioq_size = erts_port_ioq_size(prt);
Uint hsz = 3;
(void) erts_bld_uint(NULL, &hsz, ioq_size);
- hp = HAlloc(BIF_P, hsz);
+ hp = HAlloc(p, hsz);
res = erts_bld_uint(&hp, NULL, ioq_size);
}
else if (ERTS_IS_ATOM_STR("locking", item)) {
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
#ifndef ERTS_SMP
res = am_false;
#else
@@ -2875,7 +2963,7 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
#endif
}
else {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(ret, p, BADARG);
goto done;
}
@@ -2889,9 +2977,12 @@ BIF_RETTYPE port_info_2(BIF_ALIST_2)
}
-Eterm
-fun_info_2(Process* p, Eterm fun, Eterm what)
+BIF_RETTYPE
+fun_info_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm fun = BIF_ARG_1;
+ Eterm what = BIF_ARG_2;
Eterm* hp;
Eterm val;
@@ -4041,6 +4132,27 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+static void os_info_init(void)
+{
+ Eterm type = am_atom_put(os_type, strlen(os_type));
+ Eterm flav;
+ int major, minor, build;
+ char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */
+ Eterm* hp;
+
+ os_flavor(buf, 1024);
+ flav = am_atom_put(buf, strlen(buf));
+ erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm));
+ os_type_tuple = TUPLE2(hp, type, flav);
+ hp += 3;
+ os_version(&major, &minor, &build);
+ os_version_tuple = TUPLE3(hp,
+ make_small(major),
+ make_small(minor),
+ make_small(build));
+}
+
void
erts_bif_info_init(void)
{
@@ -4050,4 +4162,5 @@ erts_bif_info_init(void)
alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1);
alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1);
process_info_init();
+ os_info_init();
}
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c
index 47c48e74d6..1805366cfe 100644
--- a/erts/emulator/beam/erl_bif_lists.c
+++ b/erts/emulator/beam/erl_bif_lists.c
@@ -34,27 +34,7 @@
static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List);
-/*
- * erlang:'++'/2
- */
-
-Eterm
-ebif_plusplus_2(Process* p, Eterm A, Eterm B)
-{
- return append_2(p, A, B);
-}
-
-/*
- * erlang:'--'/2
- */
-
-Eterm
-ebif_minusminus_2(Process* p, Eterm A, Eterm B)
-{
- return subtract_2(p, A, B);
-}
-
-BIF_RETTYPE append_2(BIF_ALIST_2)
+static BIF_RETTYPE append(Process* p, Eterm A, Eterm B)
{
Eterm list;
Eterm copy;
@@ -63,18 +43,18 @@ BIF_RETTYPE append_2(BIF_ALIST_2)
Eterm* hp;
int i;
- if ((i = list_length(BIF_ARG_1)) < 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((i = list_length(A)) < 0) {
+ BIF_ERROR(p, BADARG);
}
if (i == 0) {
- BIF_RET(BIF_ARG_2);
- } else if (is_nil(BIF_ARG_2)) {
- BIF_RET(BIF_ARG_1);
+ BIF_RET(B);
+ } else if (is_nil(B)) {
+ BIF_RET(A);
}
need = 2*i;
- hp = HAlloc(BIF_P, need);
- list = BIF_ARG_1;
+ hp = HAlloc(p, need);
+ list = A;
copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2));
list = CDR(list_val(list));
hp += 2;
@@ -85,12 +65,31 @@ BIF_RETTYPE append_2(BIF_ALIST_2)
list = CDR(listp);
hp += 2;
}
- CDR(list_val(last)) = BIF_ARG_2;
+ CDR(list_val(last)) = B;
BIF_RET(copy);
}
+/*
+ * erlang:'++'/2
+ */
+
+Eterm
+ebif_plusplus_2(BIF_ALIST_2)
+{
+ return append(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+BIF_RETTYPE append_2(BIF_ALIST_2)
+{
+ return append(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+/*
+ * erlang:'--'/2
+ */
+
#define SMALL_VEC_SIZE 10
-BIF_RETTYPE subtract_2(BIF_ALIST_2)
+static Eterm subtract(Process* p, Eterm A, Eterm B)
{
Eterm list;
Eterm* hp;
@@ -103,17 +102,17 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
int n;
int m;
- if ((n = list_length(BIF_ARG_1)) < 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((n = list_length(A)) < 0) {
+ BIF_ERROR(p, BADARG);
}
- if ((m = list_length(BIF_ARG_2)) < 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((m = list_length(B)) < 0) {
+ BIF_ERROR(p, BADARG);
}
if (n == 0)
BIF_RET(NIL);
if (m == 0)
- BIF_RET(BIF_ARG_1);
+ BIF_RET(A);
/* allocate element vector */
if (n <= SMALL_VEC_SIZE)
@@ -123,7 +122,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
/* PUT ALL ELEMENTS IN VP */
vp = vec_p;
- list = BIF_ARG_1;
+ list = A;
i = n;
while(i--) {
Eterm* listp = list_val(list);
@@ -132,7 +131,7 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
}
/* UNMARK ALL DELETED CELLS */
- list = BIF_ARG_2;
+ list = B;
m = 0; /* number of deleted elements */
while(is_list(list)) {
Eterm* listp = list_val(list);
@@ -153,11 +152,11 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
if (m == n) /* All deleted ? */
res = NIL;
else if (m == 0) /* None deleted ? */
- res = BIF_ARG_1;
+ res = A;
else { /* REBUILD LIST */
res = NIL;
need = 2*(n - m);
- hp = HAlloc(BIF_P, need);
+ hp = HAlloc(p, need);
vp = vec_p + n - 1;
while(vp >= vec_p) {
if (is_value(*vp)) {
@@ -172,6 +171,16 @@ BIF_RETTYPE subtract_2(BIF_ALIST_2)
BIF_RET(res);
}
+BIF_RETTYPE ebif_minusminus_2(BIF_ALIST_2)
+{
+ return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+BIF_RETTYPE subtract_2(BIF_ALIST_2)
+{
+ return subtract(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
BIF_RETTYPE lists_member_2(BIF_ALIST_2)
{
Eterm term;
@@ -278,11 +287,12 @@ BIF_RETTYPE lists_reverse_2(BIF_ALIST_2)
}
BIF_RETTYPE
-lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
+lists_keymember_3(BIF_ALIST_3)
{
Eterm res;
- res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List);
+ res = keyfind(BIF_lists_keymember_3, BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
if (is_value(res) && is_tuple(res)) {
return am_true;
} else {
@@ -291,23 +301,25 @@ lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
}
BIF_RETTYPE
-lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
+lists_keysearch_3(BIF_ALIST_3)
{
Eterm res;
- res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List);
+ res = keyfind(BIF_lists_keysearch_3, BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
if (is_non_value(res) || is_not_tuple(res)) {
return res;
} else { /* Tuple */
- Eterm* hp = HAlloc(p, 3);
+ Eterm* hp = HAlloc(BIF_P, 3);
return TUPLE2(hp, am_value, res);
}
}
BIF_RETTYPE
-lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List)
+lists_keyfind_3(BIF_ALIST_3)
{
- return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List);
+ return keyfind(BIF_lists_keyfind_3, BIF_P,
+ BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
}
static Eterm
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
index deda7adc1f..13f8b1f63c 100644
--- a/erts/emulator/beam/erl_bif_op.c
+++ b/erts/emulator/beam/erl_bif_op.c
@@ -225,18 +225,23 @@ BIF_RETTYPE is_function_1(BIF_ALIST_1)
BIF_RETTYPE is_function_2(BIF_ALIST_2)
{
+ BIF_RET(erl_is_function(BIF_P, BIF_ARG_1, BIF_ARG_2));
+}
+
+Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2)
+{
Sint arity;
/*
* Verify argument 2 (arity); arity must be >= 0.
*/
- if (is_small(BIF_ARG_2)) {
- arity = signed_val(BIF_ARG_2);
+ if (is_small(arg2)) {
+ arity = signed_val(arg2);
if (arity < 0) {
error:
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- } else if (is_big(BIF_ARG_2) && !bignum_header_is_neg(*big_val(BIF_ARG_2))) {
+ } else if (is_big(arg2) && !bignum_header_is_neg(*big_val(arg2))) {
/* A positive bignum is OK, but can't possibly match. */
arity = -1;
} else {
@@ -244,20 +249,20 @@ BIF_RETTYPE is_function_2(BIF_ALIST_2)
goto error;
}
- if (is_fun(BIF_ARG_1)) {
- ErlFunThing* funp = (ErlFunThing *) fun_val(BIF_ARG_1);
+ if (is_fun(arg1)) {
+ ErlFunThing* funp = (ErlFunThing *) fun_val(arg1);
if (funp->arity == (Uint) arity) {
BIF_RET(am_true);
}
- } else if (is_export(BIF_ARG_1)) {
- Export* exp = (Export *) EXPAND_POINTER((export_val(BIF_ARG_1))[1]);
+ } else if (is_export(arg1)) {
+ Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]);
if (exp->code[2] == (Uint) arity) {
BIF_RET(am_true);
}
- } else if (is_tuple(BIF_ARG_1)) {
- Eterm* tp = tuple_val(BIF_ARG_1);
+ } else if (is_tuple(arg1)) {
+ Eterm* tp = tuple_val(arg1);
if (tp[0] == make_arityval(2) && is_atom(tp[1]) && is_atom(tp[2])) {
BIF_RET(am_true);
}
diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c
index 954b1f9729..58d48199fa 100644
--- a/erts/emulator/beam/erl_bif_os.c
+++ b/erts/emulator/beam/erl_bif_os.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2009. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2010. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -53,20 +53,18 @@ BIF_RETTYPE os_timestamp_0(BIF_ALIST_0)
}
-Eterm
-os_getpid_0(Process* p)
+BIF_RETTYPE os_getpid_0(BIF_ALIST_0)
{
char pid_string[21]; /* enough for a 64 bit number */
int n;
Eterm* hp;
sys_get_pid(pid_string); /* In sys.c */
n = sys_strlen(pid_string);
- hp = HAlloc(p, n*2);
+ hp = HAlloc(BIF_P, n*2);
BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL));
}
-Eterm
-os_getenv_0(Process* p)
+BIF_RETTYPE os_getenv_0(BIF_ALIST_0)
{
GETENV_STATE state;
char *cp;
@@ -80,7 +78,7 @@ os_getenv_0(Process* p)
ret = NIL;
while ((cp = getenv_string(&state)) != NULL) {
len = strlen(cp);
- hp = HAlloc(p, len*2+2);
+ hp = HAlloc(BIF_P, len*2+2);
str = buf_to_intlist(&hp, cp, len, NIL);
ret = CONS(hp, str, ret);
}
@@ -90,9 +88,11 @@ os_getenv_0(Process* p)
return ret;
}
-Eterm
-os_getenv_1(Process* p, Eterm key)
+
+BIF_RETTYPE os_getenv_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm key = BIF_ARG_1;
Eterm str;
int len, res;
char *key_str, *val;
@@ -145,9 +145,11 @@ os_getenv_1(Process* p, Eterm key)
BIF_RET(str);
}
-Eterm
-os_putenv_2(Process* p, Eterm key, Eterm value)
+BIF_RETTYPE os_putenv_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm key = BIF_ARG_1;
+ Eterm value = BIF_ARG_2;
char def_buf[1024];
char *buf = NULL;
int sep_ix, i, key_len, value_len, tot_len;
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index 3fd35dd963..b21cda6347 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -48,6 +48,9 @@ static void free_args(char **);
char *erts_default_arg0 = "default";
+static BIF_RETTYPE
+port_call(Process* p, Eterm arg1, Eterm arg2, Eterm arg3);
+
BIF_RETTYPE open_port_2(BIF_ALIST_2)
{
int port_num;
@@ -117,11 +120,9 @@ id_or_name2port(Process *c_p, Eterm id)
#define ERTS_PORT_COMMAND_FLAG_FORCE (((Uint32) 1) << 0)
#define ERTS_PORT_COMMAND_FLAG_NOSUSPEND (((Uint32) 1) << 1)
-static BIF_RETTYPE do_port_command(Process *BIF_P,
- Eterm BIF_ARG_1,
- Eterm BIF_ARG_2,
- Eterm BIF_ARG_3,
- Uint32 flags)
+static BIF_RETTYPE
+do_port_command(Process *BIF_P, Eterm arg1, Eterm arg2, Eterm arg3,
+ Uint32 flags)
{
BIF_RETTYPE res;
Port *p;
@@ -135,7 +136,7 @@ static BIF_RETTYPE do_port_command(Process *BIF_P,
profile_runnable_proc(BIF_P, am_inactive);
}
- p = id_or_name2port(BIF_P, BIF_ARG_1);
+ p = id_or_name2port(BIF_P, arg1);
if (!p) {
if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
trace_virtual_sched(BIF_P, am_in);
@@ -172,13 +173,13 @@ static BIF_RETTYPE do_port_command(Process *BIF_P,
monitor_generic(BIF_P, am_busy_port, p->id);
}
ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_port_command_3], BIF_P,
- BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ arg1, arg2, arg3);
}
} else {
int wres;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
ERTS_SMP_CHK_NO_PROC_LOCKS;
- wres = erts_write_to_port(BIF_P->id, p, BIF_ARG_2);
+ wres = erts_write_to_port(BIF_P->id, p, arg2);
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
if (wres != 0) {
ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
@@ -237,11 +238,17 @@ BIF_RETTYPE port_command_3(BIF_ALIST_3)
BIF_RETTYPE port_call_2(BIF_ALIST_2)
{
- return port_call_3(BIF_P,BIF_ARG_1,make_small(0),BIF_ARG_2);
+ return port_call(BIF_P,BIF_ARG_1, make_small(0), BIF_ARG_2);
}
BIF_RETTYPE port_call_3(BIF_ALIST_3)
{
+ return port_call(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+port_call(Process* c_p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
Uint op;
Port *p;
Uint size;
@@ -266,15 +273,15 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
/* trace of port scheduling with virtual process descheduling
* lock wait
*/
- if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(BIF_P, am_out);
+ if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) {
+ trace_virtual_sched(c_p, am_out);
}
if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) {
- profile_runnable_proc(BIF_P, am_inactive);
+ profile_runnable_proc(c_p, am_inactive);
}
- p = id_or_name2port(BIF_P, BIF_ARG_1);
+ p = id_or_name2port(c_p, arg1);
if (!p) {
error:
if (port_resp != port_result &&
@@ -286,22 +293,22 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
/* Need to virtual schedule in the process if there
* was an error.
*/
- if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(BIF_P, am_in);
+ if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) {
+ trace_virtual_sched(c_p, am_in);
}
if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) {
- profile_runnable_proc(BIF_P, am_active);
+ profile_runnable_proc(c_p, am_active);
}
if (p)
erts_port_release(p);
#ifdef ERTS_SMP
- ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN);
#else
- ERTS_BIF_CHK_EXITED(BIF_P);
+ ERTS_BIF_CHK_EXITED(c_p);
#endif
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(c_p, BADARG);
}
if ((drv = p->drv_ptr) == NULL) {
@@ -310,10 +317,10 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (drv->call == NULL) {
goto error;
}
- if (!term_to_Uint(BIF_ARG_2, &op)) {
+ if (!term_to_Uint(arg2, &op)) {
goto error;
}
- p->caller = BIF_P->id;
+ p->caller = c_p->id;
/* Lock taken, virtual schedule of port */
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
@@ -323,19 +330,19 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) {
profile_runnable_port(p, am_active);
}
- size = erts_encode_ext_size(BIF_ARG_3);
+ size = erts_encode_ext_size(arg3);
if (size > sizeof(port_input))
bytes = erts_alloc(ERTS_ALC_T_PORT_CALL_BUF, size);
endp = bytes;
- erts_encode_ext(BIF_ARG_3, &endp);
+ erts_encode_ext(arg3, &endp);
real_size = endp - bytes;
if (real_size > size) {
erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
__FILE__, __LINE__, endp - (bytes + size));
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
prc = (char *) port_resp;
fpe_was_unmasked = erts_block_fpe();
ret = drv->call((ErlDrvData)p->drv_data,
@@ -356,7 +363,7 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
port_resp = (byte *) prc;
p->caller = NIL;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
#ifdef HARDDEBUG
{
int z;
@@ -382,14 +389,14 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (result_size < 0) {
goto error;
}
- hp = HAlloc(BIF_P, result_size);
+ hp = HAlloc(c_p, result_size);
hp_end = hp + result_size;
endp = port_resp;
- res = erts_decode_ext(&hp, &MSO(BIF_P), &endp);
+ res = erts_decode_ext(&hp, &MSO(c_p), &endp);
if (res == THE_NON_VALUE) {
goto error;
}
- HRelease(BIF_P, hp_end, hp);
+ HRelease(c_p, hp_end, hp);
if (port_resp != port_result && !(ret_flags & DRIVER_CALL_KEEP_BUFFER)) {
driver_free(port_resp);
}
@@ -398,16 +405,16 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
if (p)
erts_port_release(p);
#ifdef ERTS_SMP
- ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_BIF_CHK_PENDING_EXIT(c_p, ERTS_PROC_LOCK_MAIN);
#else
- ERTS_BIF_CHK_EXITED(BIF_P);
+ ERTS_BIF_CHK_EXITED(c_p);
#endif
- if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) {
- trace_virtual_sched(BIF_P, am_in);
+ if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) {
+ trace_virtual_sched(c_p, am_in);
}
if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) {
- profile_runnable_proc(BIF_P, am_active);
+ profile_runnable_proc(c_p, am_active);
}
return res;
diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c
index 26891c4348..6b843d2e08 100644
--- a/erts/emulator/beam/erl_bif_re.c
+++ b/erts/emulator/beam/erl_bif_re.c
@@ -45,6 +45,7 @@ static Export *urun_trap_exportp = NULL;
static Export *ucompile_trap_exportp = NULL;
static BIF_RETTYPE re_exec_trap(BIF_ALIST_3);
+static BIF_RETTYPE re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
static void *erts_erts_pcre_malloc(size_t size) {
return erts_alloc(ERTS_ALC_T_RE_HEAP,size);
@@ -414,8 +415,8 @@ build_compile_result(Process *p, Eterm error_tag, pcre *result, int errcode, con
* Compile BIFs
*/
-BIF_RETTYPE
-re_compile_2(BIF_ALIST_2)
+static BIF_RETTYPE
+re_compile(Process* p, Eterm arg1, Eterm arg2)
{
Uint slen;
char *expr;
@@ -429,43 +430,49 @@ re_compile_2(BIF_ALIST_2)
int unicode = 0;
- if (parse_options(BIF_ARG_2,&options,NULL,&pflags,NULL,NULL)
+ if (parse_options(arg2,&options,NULL,&pflags,NULL,NULL)
< 0) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
if (pflags & PARSE_FLAG_UNIQUE_EXEC_OPT) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;
- if (pflags & PARSE_FLAG_UNICODE && !is_binary(BIF_ARG_1)) {
- BIF_TRAP2(ucompile_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2);
+ if (pflags & PARSE_FLAG_UNICODE && !is_binary(arg1)) {
+ BIF_TRAP2(ucompile_trap_exportp, p, arg1, arg2);
}
- if (erts_iolist_size(BIF_ARG_1, &slen)) {
- BIF_ERROR(BIF_P,BADARG);
+ if (erts_iolist_size(arg1, &slen)) {
+ BIF_ERROR(p,BADARG);
}
expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1);
- if (io_list_to_buf(BIF_ARG_1, expr, slen) != 0) {
+ if (io_list_to_buf(arg1, expr, slen) != 0) {
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
expr[slen]='\0';
result = erts_pcre_compile2(expr, options, &errcode,
&errstr, &errofset, default_table);
- ret = build_compile_result(BIF_P, am_error, result, errcode,
+ ret = build_compile_result(p, am_error, result, errcode,
errstr, errofset, unicode, 1);
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
BIF_RET(ret);
}
BIF_RETTYPE
+re_compile_2(BIF_ALIST_2)
+{
+ return re_compile(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+BIF_RETTYPE
re_compile_1(BIF_ALIST_1)
{
- return re_compile_2(BIF_P,BIF_ARG_1,NIL);
+ return re_compile(BIF_P, BIF_ARG_1, NIL);
}
/*
@@ -845,8 +852,8 @@ build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code)
/*
* The actual re:run/2,3 BIFs
*/
-BIF_RETTYPE
-re_run_3(BIF_ALIST_3)
+static BIF_RETTYPE
+re_run(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
{
const pcre *code_tmp;
RestartContext restart;
@@ -865,15 +872,15 @@ re_run_3(BIF_ALIST_3)
Eterm capture[CAPSPEC_SIZE];
int is_list_cap;
- if (parse_options(BIF_ARG_3,&comp_options,&options,&pflags,&startoffset,capture)
+ if (parse_options(arg3,&comp_options,&options,&pflags,&startoffset,capture)
< 0) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
is_list_cap = ((pflags & PARSE_FLAG_CAPTURE_OPT) &&
(capture[CAPSPEC_TYPE] == am_list));
- if (is_not_tuple(BIF_ARG_2) || (arityval(*tuple_val(BIF_ARG_2)) != 4)) {
- if (is_binary(BIF_ARG_2) || is_list(BIF_ARG_2) || is_nil(BIF_ARG_2)) {
+ if (is_not_tuple(arg2) || (arityval(*tuple_val(arg2)) != 4)) {
+ if (is_binary(arg2) || is_list(arg2) || is_nil(arg2)) {
/* Compile from textual RE */
Uint slen;
char *expr;
@@ -884,19 +891,19 @@ re_run_3(BIF_ALIST_3)
int capture_count;
if (pflags & PARSE_FLAG_UNICODE &&
- (!is_binary(BIF_ARG_2) || !is_binary(BIF_ARG_1) ||
+ (!is_binary(arg2) || !is_binary(arg1) ||
(is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) {
- BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ BIF_TRAP3(urun_trap_exportp, p, arg1, arg2, arg3);
}
- if (erts_iolist_size(BIF_ARG_2, &slen)) {
- BIF_ERROR(BIF_P,BADARG);
+ if (erts_iolist_size(arg2, &slen)) {
+ BIF_ERROR(p,BADARG);
}
expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1);
- if (io_list_to_buf(BIF_ARG_2, expr, slen) != 0) {
+ if (io_list_to_buf(arg2, expr, slen) != 0) {
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
expr[slen]='\0';
result = erts_pcre_compile2(expr, comp_options, &errcode,
@@ -905,11 +912,11 @@ re_run_3(BIF_ALIST_3)
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
/* Compilation error gives badarg except in the compile
function */
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
if (pflags & PARSE_FLAG_GLOBAL) {
Eterm precompiled =
- build_compile_result(BIF_P, am_error,
+ build_compile_result(p, am_error,
result, errcode,
errstr, errofset,
(pflags &
@@ -917,13 +924,13 @@ re_run_3(BIF_ALIST_3)
0);
Eterm *hp,r;
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
- hp = HAlloc(BIF_P,4);
- /* BIF_ARG_2 is in the tuple just to make exceptions right */
- r = TUPLE3(hp,BIF_ARG_3,
+ hp = HAlloc(p,4);
+ /* arg2 is in the tuple just to make exceptions right */
+ r = TUPLE3(hp,arg3,
((pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) ?
am_true :
- am_false), BIF_ARG_2);
- BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, precompiled, r);
+ am_false), arg2);
+ BIF_TRAP3(grun_trap_exportp, p, arg1, precompiled, r);
}
erts_pcre_fullinfo(result, NULL, PCRE_INFO_SIZE, &code_size);
@@ -935,31 +942,31 @@ re_run_3(BIF_ALIST_3)
erts_free(ERTS_ALC_T_RE_TMP_BUF, expr);
/*unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;*/
} else {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
} else {
if (pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
- tp = tuple_val(BIF_ARG_2);
+ tp = tuple_val(arg2);
if (tp[1] != am_re_pattern || is_not_small(tp[2]) ||
is_not_small(tp[3]) || is_not_binary(tp[4])) {
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
if (unsigned_val(tp[3]) &&
- (!is_binary(BIF_ARG_1) ||
+ (!is_binary(arg1) ||
(is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { /* unicode */
- BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2,
- BIF_ARG_3);
+ BIF_TRAP3(urun_trap_exportp, p, arg1, arg2,
+ arg3);
}
if (pflags & PARSE_FLAG_GLOBAL) {
Eterm *hp,r;
- hp = HAlloc(BIF_P,3);
- r = TUPLE2(hp,BIF_ARG_3,am_false);
- BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2,
+ hp = HAlloc(p,3);
+ r = TUPLE2(hp,arg3,am_false);
+ BIF_TRAP3(grun_trap_exportp, p, arg1, arg2,
r);
}
@@ -968,7 +975,7 @@ re_run_3(BIF_ALIST_3)
if ((code_tmp = (const pcre *)
erts_get_aligned_binary_bytes(tp[4], &temp_alloc)) == NULL) {
erts_free_aligned_binary_bytes(temp_alloc);
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size);
memcpy(restart.code, code_tmp, code_size);
@@ -980,7 +987,7 @@ re_run_3(BIF_ALIST_3)
restart.ovector = erts_alloc(ERTS_ALC_T_RE_SUBJECT, ovsize * sizeof(int));
restart.extra.flags = PCRE_EXTRA_TABLES | PCRE_EXTRA_LOOP_LIMIT;
restart.extra.tables = default_table;
- restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(BIF_P) * LOOP_FACTOR;
+ restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(p) * LOOP_FACTOR;
loop_limit_tmp = max_loop_limit; /* To lesser probability of race in debug
situation (erts_debug) */
if (restart.extra.loop_limit > loop_limit_tmp) {
@@ -996,7 +1003,7 @@ re_run_3(BIF_ALIST_3)
if ((restart.ret_info = build_capture(capture,restart.code)) == NULL) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code);
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
}
@@ -1004,7 +1011,7 @@ re_run_3(BIF_ALIST_3)
copying, also binary returns can be sub binaries in that case */
restart.flags = 0;
- if (is_binary(BIF_ARG_1)) {
+ if (is_binary(arg1)) {
Eterm real_bin;
Uint offset;
Eterm* bptr;
@@ -1012,9 +1019,9 @@ re_run_3(BIF_ALIST_3)
int bitsize;
ProcBin* pb;
- ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize);
+ ERTS_GET_REAL_BIN(arg1, real_bin, offset, bitoffs, bitsize);
- slength = binary_size(BIF_ARG_1);
+ slength = binary_size(arg1);
bptr = binary_val(real_bin);
if (bitsize != 0 || bitoffs != 0 || (*bptr != HEADER_PROC_BIN)) {
goto handle_iolist;
@@ -1027,24 +1034,24 @@ re_run_3(BIF_ALIST_3)
restart.flags |= RESTART_FLAG_SUBJECT_IN_BINARY;
} else {
handle_iolist:
- if (erts_iolist_size(BIF_ARG_1, &slength)) {
+ if (erts_iolist_size(arg1, &slength)) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code);
if (restart.ret_info != NULL) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info);
}
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
restart.subject = erts_alloc(ERTS_ALC_T_RE_SUBJECT, slength);
- if (io_list_to_buf(BIF_ARG_1, restart.subject, slength) != 0) {
+ if (io_list_to_buf(arg1, restart.subject, slength) != 0) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code);
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.subject);
if (restart.ret_info != NULL) {
erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info);
}
- BIF_ERROR(BIF_P,BADARG);
+ BIF_ERROR(p,BADARG);
}
}
@@ -1056,7 +1063,7 @@ handle_iolist:
rc = erts_pcre_exec(restart.code, &(restart.extra), restart.subject, slength, startoffset,
options, restart.ovector, ovsize);
ASSERT(loop_count != 0xFFFFFFFF);
- BUMP_REDS(BIF_P, loop_count / LOOP_FACTOR);
+ BUMP_REDS(p, loop_count / LOOP_FACTOR);
if (rc == PCRE_ERROR_LOOP_LIMIT) {
/* Trap */
Binary *mbp = erts_create_magic_binary(sizeof(RestartContext),
@@ -1065,17 +1072,17 @@ handle_iolist:
Eterm magic_bin;
Eterm *hp;
memcpy(restartp,&restart,sizeof(RestartContext));
- BUMP_ALL_REDS(BIF_P);
- hp = HAlloc(BIF_P, PROC_BIN_SIZE);
- magic_bin = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mbp);
+ BUMP_ALL_REDS(p);
+ hp = HAlloc(p, PROC_BIN_SIZE);
+ magic_bin = erts_mk_magic_binary_term(&hp, &MSO(p), mbp);
BIF_TRAP3(&re_exec_trap_export,
- BIF_P,
- BIF_ARG_1,
- BIF_ARG_2 /* To avoid GC of precompiled code, XXX: not utilized yet */,
+ p,
+ arg1,
+ arg2 /* To avoid GC of precompiled code, XXX: not utilized yet */,
magic_bin);
}
- res = build_exec_return(BIF_P, rc, &restart, BIF_ARG_1);
+ res = build_exec_return(p, rc, &restart, arg1);
cleanup_restart_context(&restart);
@@ -1083,9 +1090,15 @@ handle_iolist:
}
BIF_RETTYPE
+re_run_3(BIF_ALIST_3)
+{
+ return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+BIF_RETTYPE
re_run_2(BIF_ALIST_2)
{
- return re_run_3(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL);
+ return re_run(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL);
}
/*
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 7a08182e18..af49345410 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -47,6 +47,11 @@ static Binary *erts_default_meta_match_spec;
static struct trace_pattern_flags erts_default_trace_pattern_flags;
static Eterm erts_default_meta_tracer_pid;
+static Eterm
+trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist);
+static BIF_RETTYPE
+system_monitor(Process *p, Eterm monitor_pid, Eterm list);
+
static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/
static int already_traced(Process *p, Process *tracee_p, Eterm tracer);
static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer);
@@ -76,13 +81,19 @@ erts_bif_trace_init(void)
*/
Eterm
-trace_pattern_2(Process* p, Eterm MFA, Eterm Pattern)
+trace_pattern_2(BIF_ALIST_2)
{
- return trace_pattern_3(p,MFA,Pattern,NIL);
+ return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL);
}
Eterm
-trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
+trace_pattern_3(BIF_ALIST_3)
+{
+ return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static Eterm
+trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist)
{
DeclareTmpHeap(mfa,3,p); /* Not really heap here, but might be when setting pattern */
int i;
@@ -435,9 +446,12 @@ erts_trace_flags(Eterm List,
return 0;
}
-Eterm
-trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list)
+Eterm trace_3(BIF_ALIST_3)
{
+ Process* p = BIF_P;
+ Eterm pid_spec = BIF_ARG_1;
+ Eterm how = BIF_ARG_2;
+ Eterm list = BIF_ARG_3;
int on;
Eterm tracer = NIL;
int matches = 0;
@@ -820,9 +834,11 @@ static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer)
* Return information about a process or an external function being traced.
*/
-Eterm
-trace_info_2(Process* p, Eterm What, Eterm Key)
+Eterm trace_info_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm What = BIF_ARG_1;
+ Eterm Key = BIF_ARG_2;
Eterm res;
if (What == am_on_load) {
res = trace_info_on_load(p, Key);
@@ -1752,23 +1768,20 @@ new_seq_trace_token(Process* p)
}
}
-BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
+BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
{
- Eterm item;
Eterm res;
Eterm* hp;
Uint current_flag;
- if (is_not_atom(BIF_ARG_1)) {
- BIF_ERROR(BIF_P, BADARG);
+ if (is_not_atom(item)) {
+ BIF_ERROR(p, BADARG);
}
- item = BIF_ARG_1;
-
- if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
+ if (SEQ_TRACE_TOKEN(p) == NIL) {
if ((item == am_send) || (item == am_receive) ||
(item == am_print) || (item == am_timestamp)) {
- hp = HAlloc(BIF_P,3);
+ hp = HAlloc(p,3);
res = TUPLE2(hp, item, am_false);
BIF_RET(res);
} else if ((item == am_label) || (item == am_serial)) {
@@ -1778,35 +1791,40 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
}
}
- if (BIF_ARG_1 == am_send) {
+ if (item == am_send) {
current_flag = SEQ_TRACE_SEND;
- } else if (BIF_ARG_1 == am_receive) {
+ } else if (item == am_receive) {
current_flag = SEQ_TRACE_RECEIVE;
- } else if (BIF_ARG_1 == am_print) {
+ } else if (item == am_print) {
current_flag = SEQ_TRACE_PRINT;
- } else if (BIF_ARG_1 == am_timestamp) {
+ } else if (item == am_timestamp) {
current_flag = SEQ_TRACE_TIMESTAMP;
} else {
current_flag = 0;
}
if (current_flag) {
- res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(BIF_P)) & current_flag ?
+ res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p)) & current_flag ?
am_true : am_false;
} else if (item == am_label) {
- res = SEQ_TRACE_TOKEN_LABEL(BIF_P);
+ res = SEQ_TRACE_TOKEN_LABEL(p);
} else if (item == am_serial) {
- hp = HAlloc(BIF_P, 3);
- res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(BIF_P), SEQ_TRACE_TOKEN_SERIAL(BIF_P));
+ hp = HAlloc(p, 3);
+ res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p), SEQ_TRACE_TOKEN_SERIAL(p));
} else {
error:
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- hp = HAlloc(BIF_P, 3);
+ hp = HAlloc(p, 3);
res = TUPLE2(hp, item, res);
BIF_RET(res);
}
+BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
+{
+ BIF_RET(erl_seq_trace_info(BIF_P, BIF_ARG_1));
+}
+
/*
seq_trace_print(Message) -> true | false
This function passes Message to the system_tracer
@@ -1919,23 +1937,35 @@ static Eterm system_monitor_get(Process *p)
}
-BIF_RETTYPE system_monitor_0(Process *p) {
- BIF_RET(system_monitor_get(p));
+BIF_RETTYPE system_monitor_0(BIF_ALIST_0)
+{
+ BIF_RET(system_monitor_get(BIF_P));
}
-BIF_RETTYPE system_monitor_1(Process *p, Eterm spec) {
+BIF_RETTYPE system_monitor_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm spec = BIF_ARG_1;
+
if (spec == am_undefined) {
- BIF_RET(system_monitor_2(p, spec, NIL));
+ BIF_RET(system_monitor(p, spec, NIL));
} else if (is_tuple(spec)) {
Eterm *tp = tuple_val(spec);
if (tp[0] != make_arityval(2)) goto error;
- BIF_RET(system_monitor_2(p, tp[1], tp[2]));
+ BIF_RET(system_monitor(p, tp[1], tp[2]));
}
error:
BIF_ERROR(p, BADARG);
}
-BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) {
+BIF_RETTYPE system_monitor_2(BIF_ALIST_2)
+{
+ return system_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE
+system_monitor(Process *p, Eterm monitor_pid, Eterm list)
+{
Eterm prev;
int system_blocked = 0;
@@ -2053,11 +2083,16 @@ static Eterm system_profile_get(Process *p) {
}
}
-BIF_RETTYPE system_profile_0(Process *p) {
- BIF_RET(system_profile_get(p));
+BIF_RETTYPE system_profile_0(BIF_ALIST_0)
+{
+ BIF_RET(system_profile_get(BIF_P));
}
-BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) {
+BIF_RETTYPE system_profile_2(BIF_ALIST_2)
+{
+ Process *p = BIF_P;
+ Eterm profiler = BIF_ARG_1;
+ Eterm list = BIF_ARG_2;
Eterm prev;
int system_blocked = 0;
Process *profiler_p = NULL;
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 326a5c136b..6f7309f493 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -845,8 +845,7 @@ erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm arg))
dst[1] = 0x80 | (val & 0x3F);
num_bits = 16;
} else if (val < 0x10000UL) {
- if ((0xD800 <= val && val <= 0xDFFF) ||
- val == 0xFFFE || val == 0xFFFF) {
+ if (0xD800 <= val && val <= 0xDFFF) {
return 0;
}
dst[0] = 0xE0 | (val >> 12);
@@ -886,8 +885,7 @@ erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm arg, Uint flags))
return 0;
}
val = unsigned_val(arg);
- if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF) ||
- val == 0xFFFE || val == 0xFFFF) {
+ if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF)) {
return 0;
}
@@ -1652,8 +1650,7 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb)
return THE_NON_VALUE;
}
result = (((result << 6) + a) << 6) + b - (Eterm) 0x000E2080UL;
- if ((0xD800 <= result && result <= 0xDFFF) ||
- result == 0xFFFE || result == 0xFFFF) {
+ if (0xD800 <= result && result <= 0xDFFF) {
return THE_NON_VALUE;
}
mb->offset += 24;
@@ -1723,9 +1720,6 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags)
w1 = (src[0] << 8) | src[1];
}
if (w1 < 0xD800 || w1 > 0xDFFF) {
- if (w1 == 0xFFFE || w1 == 0xFFFF) {
- return THE_NON_VALUE;
- }
mb->offset += 16;
return make_small(w1);
} else if (w1 > 0xDBFF) {
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 0327850cb9..d8b4294a30 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -129,8 +129,6 @@ static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed tab
static Uint meta_main_tab_seq_incr;
static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */
-
-
/*
** The meta hash table of all NAMED ets tables
*/
@@ -202,12 +200,17 @@ static int free_table_cont(Process *p,
int first,
int clean_meta_tab);
static void print_table(int to, void *to_arg, int show, DbTable* tb);
-static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1);
-static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1);
-static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1);
-static BIF_RETTYPE ets_delete_trap(Process *p, Eterm a1);
+static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1);
+static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1);
static Eterm table_info(Process* p, DbTable* tb, Eterm What);
+static BIF_RETTYPE ets_select1(Process* p, Eterm arg1);
+static BIF_RETTYPE ets_select2(Process* p, Eterm arg1, Eterm arg2);
+static BIF_RETTYPE ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3);
+
+
/*
* Exported global
*/
@@ -1297,7 +1300,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
Uint32 status;
Sint keypos;
int is_named, is_fine_locked, frequent_read, is_compressed;
+#ifdef DEBUG
int cret;
+#endif
DeclareTmpHeap(meta_tuple,3,BIF_P);
DbTableMethod* meth;
erts_smp_rwmtx_t *mmtl;
@@ -1445,7 +1450,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
tb->common.fixations = NULL;
tb->common.compress = is_compressed;
- cret = meth->db_create(BIF_P, tb);
+#ifdef DEBUG
+ cret =
+#endif
+ meth->db_create(BIF_P, tb);
ASSERT(cret == DB_ERROR_NONE);
erts_smp_spin_lock(&meta_main_tab_main_lock);
@@ -1942,8 +1950,10 @@ BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2)
/*
** This is for trapping, cannot be called directly.
*/
-static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1)
+static BIF_RETTYPE ets_select_delete_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2109,7 +2119,7 @@ BIF_RETTYPE ets_slot_2(BIF_ALIST_2)
BIF_RETTYPE ets_match_1(BIF_ALIST_1)
{
- return ets_select_1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE ets_match_2(BIF_ALIST_2)
@@ -2125,7 +2135,7 @@ BIF_RETTYPE ets_match_2(BIF_ALIST_2)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_2(BIF_P, BIF_ARG_1, ms);
+ res = ets_select2(BIF_P, BIF_ARG_1, ms);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2143,7 +2153,7 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
+ res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2151,6 +2161,12 @@ BIF_RETTYPE ets_match_3(BIF_ALIST_3)
BIF_RETTYPE ets_select_3(BIF_ALIST_3)
{
+ return ets_select3(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static BIF_RETTYPE
+ets_select3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3)
+{
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2161,22 +2177,22 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3)
CHECK_TABLES();
/* Chunk size strictly greater than 0 */
- if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) {
- BIF_ERROR(BIF_P, BADARG);
+ if (is_not_small(arg3) || (chunk_size = signed_val(arg3)) <= 0) {
+ BIF_ERROR(p, BADARG);
}
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- safety = ITERATION_SAFETY(BIF_P,tb);
+ safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_chunk(BIF_P, tb,
- BIF_ARG_2, chunk_size,
+ cret = tb->common.meth->db_select_chunk(p, tb,
+ arg2, chunk_size,
0 /* not reversed */,
&ret);
- if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
- fix_table_locked(BIF_P, tb);
+ if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ fix_table_locked(p, tb);
}
if (safety == ITER_UNSAFE) {
local_unfix_table(tb);
@@ -2188,22 +2204,24 @@ BIF_RETTYPE ets_select_3(BIF_ALIST_3)
ERTS_BIF_PREP_RET(result, ret);
break;
case DB_ERROR_SYSRES:
- ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT);
break;
default:
- ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
break;
}
- erts_match_set_release_result(BIF_P);
+ erts_match_set_release_result(p);
return result;
}
/* We get here instead of in the real BIF when trapping */
-static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1)
+static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2248,6 +2266,11 @@ static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1)
BIF_RETTYPE ets_select_1(BIF_ALIST_1)
{
+ return ets_select1(BIF_P, BIF_ARG_1);
+}
+
+static BIF_RETTYPE ets_select1(Process *p, Eterm arg1)
+{
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2261,28 +2284,27 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1)
* Make sure that the table exists.
*/
- if (!is_tuple(BIF_ARG_1)) {
- if (BIF_ARG_1 == am_EOT) {
+ if (!is_tuple(arg1)) {
+ if (arg1 == am_EOT) {
BIF_RET(am_EOT);
}
- BIF_ERROR(BIF_P, BADARG);
+ BIF_ERROR(p, BADARG);
}
- tptr = tuple_val(BIF_ARG_1);
+ tptr = tuple_val(arg1);
if (arityval(*tptr) < 1 ||
- (tb = db_get_table(BIF_P, tptr[1], DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ (tb = db_get_table(p, tptr[1], DB_READ, LCK_READ)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- safety = ITERATION_SAFETY(BIF_P,tb);
+ safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_continue(BIF_P,tb,
- BIF_ARG_1, &ret);
+ cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret);
- if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
- fix_table_locked(BIF_P, tb);
+ if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ fix_table_locked(p, tb);
}
if (safety == ITER_UNSAFE) {
local_unfix_table(tb);
@@ -2294,20 +2316,26 @@ BIF_RETTYPE ets_select_1(BIF_ALIST_1)
ERTS_BIF_PREP_RET(result, ret);
break;
case DB_ERROR_SYSRES:
- ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT);
break;
default:
- ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
break;
}
- erts_match_set_release_result(BIF_P);
+ erts_match_set_release_result(p);
return result;
}
BIF_RETTYPE ets_select_2(BIF_ALIST_2)
{
+ return ets_select2(BIF_P, BIF_ARG_1, BIF_ARG_2);
+}
+
+static BIF_RETTYPE
+ets_select2(Process* p, Eterm arg1, Eterm arg2)
+{
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2320,19 +2348,19 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2)
* Make sure that the table exists.
*/
- if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) {
- BIF_ERROR(BIF_P, BADARG);
+ if ((tb = db_get_table(p, arg1, DB_READ, LCK_READ)) == NULL) {
+ BIF_ERROR(p, BADARG);
}
- safety = ITERATION_SAFETY(BIF_P,tb);
+ safety = ITERATION_SAFETY(p,tb);
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(BIF_P, tb, BIF_ARG_2,
+ cret = tb->common.meth->db_select(p, tb, arg2,
0, &ret);
- if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
- fix_table_locked(BIF_P, tb);
+ if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ fix_table_locked(p, tb);
}
if (safety == ITER_UNSAFE) {
local_unfix_table(tb);
@@ -2344,21 +2372,23 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2)
ERTS_BIF_PREP_RET(result, ret);
break;
case DB_ERROR_SYSRES:
- ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT);
+ ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT);
break;
default:
- ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG);
+ ERTS_BIF_PREP_ERROR(result, p, BADARG);
break;
}
- erts_match_set_release_result(BIF_P);
+ erts_match_set_release_result(p);
return result;
}
/* We get here instead of in the real BIF when trapping */
-static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1)
+static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
BIF_RETTYPE result;
DbTable* tb;
int cret;
@@ -2499,7 +2529,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1)
{
- return ets_select_1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
@@ -2553,7 +2583,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
*/
BIF_RETTYPE ets_match_object_1(BIF_ALIST_1)
{
- return ets_select_1(BIF_P, BIF_ARG_1);
+ return ets_select1(BIF_P, BIF_ARG_1);
}
BIF_RETTYPE ets_match_object_2(BIF_ALIST_2)
@@ -2569,7 +2599,7 @@ BIF_RETTYPE ets_match_object_2(BIF_ALIST_2)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_2(BIF_P, BIF_ARG_1, ms);
+ res = ets_select2(BIF_P, BIF_ARG_1, ms);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2587,7 +2617,7 @@ BIF_RETTYPE ets_match_object_3(BIF_ALIST_3)
ms = TUPLE3(hp, BIF_ARG_2, NIL, ms);
hp += 4;
ms = CONS(hp, ms, NIL);
- res = ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
+ res = ets_select3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3);
UnUseTmpHeap(8,BIF_P);
return res;
}
@@ -2606,7 +2636,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
int i;
Eterm* hp;
/*Process* rp = NULL;*/
+ /* If/when we implement lockless private tables:
Eterm owner;
+ */
if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) {
if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) {
@@ -2615,7 +2647,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+ /* If/when we implement lockless private tables:
owner = tb->common.owner;
+ */
/* If/when we implement lockless private tables:
if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) {
@@ -3521,8 +3555,10 @@ static void free_heir_data(DbTable* tb)
#endif
}
-static BIF_RETTYPE ets_delete_trap(Process *p, Eterm cont)
+static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm cont = BIF_ARG_1;
int trap;
Eterm* ptr = big_val(cont);
DbTable *tb = *((DbTable **) (UWord) (ptr + 1));
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index c6f0d80e32..312050b931 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -344,8 +344,8 @@ static int do_partly_bound_can_match_lesser(Eterm a, Eterm b,
int *done);
static int do_partly_bound_can_match_greater(Eterm a, Eterm b,
int *done);
-static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1,
- Eterm a2, Eterm a3);
+static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3);
+
/* Method interface functions */
static int db_first_tree(Process *p, DbTable *tbl,
@@ -844,8 +844,12 @@ static int db_slot_tree(Process *p, DbTable *tbl,
-static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, Eterm a2, Eterm a3)
+static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3)
{
+ Process *p = BIF_P;
+ Eterm a1 = BIF_ARG_1;
+ Eterm a2 = BIF_ARG_2;
+ Eterm a3 = BIF_ARG_3;
Eterm list;
Eterm result;
Eterm* hp;
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 7dfbb2ed02..35e53aaa0e 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -495,7 +495,7 @@ static erts_smp_atomic32_t trace_control_word;
/* This needs to be here, before the bif table... */
-static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val);
+static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1);
/*
** The table of callable bif's, i e guard bif's and
@@ -908,14 +908,18 @@ static void db_free_tmp_uncompressed(DbTerm* obj);
/*
** Pseudo BIF:s to be callable from the PAM VM.
*/
-
-BIF_RETTYPE db_get_trace_control_word_0(Process *p)
+BIF_RETTYPE db_get_trace_control_word(Process *p)
{
Uint32 tcw = (Uint32) erts_smp_atomic32_read_acqb(&trace_control_word);
BIF_RET(erts_make_integer((Uint) tcw, p));
}
-BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new)
+BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0)
+{
+ BIF_RET(db_get_trace_control_word(BIF_P));
+}
+
+BIF_RETTYPE db_set_trace_control_word(Process *p, Eterm new)
{
Uint val;
Uint32 old_tcw;
@@ -923,20 +927,27 @@ BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new)
BIF_ERROR(p, BADARG);
if (val != ((Uint32)val))
BIF_ERROR(p, BADARG);
-
+
old_tcw = (Uint32) erts_smp_atomic32_xchg_relb(&trace_control_word,
(erts_aint32_t) val);
BIF_RET(erts_make_integer((Uint) old_tcw, p));
}
-static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm new)
+BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1)
{
+ BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_1));
+}
+
+static Eterm db_set_trace_control_word_fake_1(BIF_ALIST_1)
+{
+ Process *p = BIF_P;
+ Eterm new = BIF_ARG_1;
Uint val;
if (!term_to_Uint(new, &val))
BIF_ERROR(p, BADARG);
if (val != ((Uint32)val))
BIF_ERROR(p, BADARG);
- BIF_RET(db_get_trace_control_word_0(p));
+ BIF_RET(db_get_trace_control_word(p));
}
/*
@@ -1704,6 +1715,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
Process *current_scheduled;
ErtsSchedulerData *esdp;
Eterm (*bif)(Process*, ...);
+ Eterm bif_args[3];
int fail_label;
int atomic_trace;
#if HALFWORD_HEAP
@@ -1957,7 +1969,7 @@ restart:
break;
case matchCall0:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc);
+ t = (*bif)(build_proc, bif_args);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1968,7 +1980,7 @@ restart:
break;
case matchCall1:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc, esp[-1]);
+ t = (*bif)(build_proc, esp-1);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1979,7 +1991,9 @@ restart:
break;
case matchCall2:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc, esp[-1], esp[-2]);
+ bif_args[0] = esp[-1];
+ bif_args[1] = esp[-2];
+ t = (*bif)(build_proc, bif_args);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -1991,7 +2005,10 @@ restart:
break;
case matchCall3:
bif = (Eterm (*)(Process*, ...)) *pc++;
- t = (*bif)(build_proc, esp[-1], esp[-2], esp[-3]);
+ bif_args[0] = esp[-1];
+ bif_args[1] = esp[-2];
+ bif_args[2] = esp[-3];
+ t = (*bif)(build_proc, bif_args);
if (is_non_value(t)) {
if (do_catch)
t = FAIL_TERM;
@@ -2846,7 +2863,9 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
Uint new_sz = offset + db_size_dbterm_comp(tb, obj);
byte* basep;
DbTerm* newp;
+#ifdef DEBUG
byte* top;
+#endif
ASSERT(tb->compress);
if (old != 0) {
@@ -2868,7 +2887,10 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
}
newp->size = size_object(obj);
- top = copy_to_comp(tb, obj, newp, new_sz);
+#ifdef DEBUG
+ top =
+#endif
+ copy_to_comp(tb, obj, newp, new_sz);
ASSERT(top <= basep + new_sz);
/* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */
@@ -4970,7 +4992,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
static Eterm seq_trace_fake(Process *p, Eterm arg1)
{
- Eterm result = seq_trace_info_1(p,arg1);
+ Eterm result = erl_seq_trace_info(p, arg1);
if (is_tuple(result) && *tuple_val(result) == 2) {
return (tuple_val(result))[2];
}
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index bb1751d309..6a96e174e1 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -326,8 +326,10 @@ ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b)
(T)->common.owner == (P)->id)
/* Function prototypes */
-Eterm db_get_trace_control_word_0(Process *p);
-Eterm db_set_trace_control_word_1(Process *p, Eterm val);
+BIF_RETTYPE db_get_trace_control_word(Process* p);
+BIF_RETTYPE db_set_trace_control_word(Process* p, Eterm tcw);
+BIF_RETTYPE db_get_trace_control_word_0(BIF_ALIST_0);
+BIF_RETTYPE db_set_trace_control_word_1(BIF_ALIST_1);
void db_initialize_util(void);
Eterm db_getkey(int keypos, Eterm obj);
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index e3445bcdc5..36615f913d 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -315,7 +315,12 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
if (is_non_value(result)) {
if (p->freason == TRAP) {
- cost = erts_garbage_collect(p, 0, p->def_arg_reg, p->arity);
+ #if HIPE
+ if (regs == NULL) {
+ regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array;
+ }
+ #endif
+ cost = erts_garbage_collect(p, 0, regs, p->arity);
} else {
cost = erts_garbage_collect(p, 0, regs, arity);
}
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index ef86e6db5e..36c5a1a30e 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -128,6 +128,8 @@ int erts_modified_timing_level;
int erts_no_crash_dump = 0; /* Use -d to suppress crash dump. */
+int erts_no_line_info = 0; /* -L: Don't load line information */
+
/*
* Other global variables.
*/
@@ -948,7 +950,9 @@ erl_start(int argc, char **argv)
case 'l':
display_loads++;
break;
-
+ case 'L':
+ erts_no_line_info = 1;
+ break;
case 'v':
#ifdef DEBUG
if (argv[i][2] == '\0') {
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index 47597f302b..1a84950120 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -948,8 +948,10 @@ static void erts_dump_links(ErtsLink *root, int indent)
erts_destroy_tmp_dsbuf(dsbufp);
}
-Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid)
+Eterm erts_debug_dump_monitors_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm pid = BIF_ARG_1;
Process *rp;
DistEntry *dep;
rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK);
@@ -976,8 +978,10 @@ Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid)
}
}
-Eterm erts_debug_dump_links_1(Process *p, Eterm pid)
+Eterm erts_debug_dump_links_1(BIF_ALIST_1)
{
+ Process *p = BIF_P;
+ Eterm pid = BIF_ARG_1;
Process *rp;
DistEntry *dep;
if (is_internal_port(pid)) {
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 6e7ac43676..1302eff114 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -130,10 +130,13 @@ static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif)
env->tmp_obj_list = NULL;
}
-/* Temporary object header, auto-deallocated when NIF returns. */
+/* Temporary object header, auto-deallocated when NIF returns
+ * or when independent environment is cleared.
+ */
struct enif_tmp_obj_t {
struct enif_tmp_obj_t* next;
void (*dtor)(struct enif_tmp_obj_t*);
+ ErtsAlcType_t allocator;
/*char data[];*/
};
@@ -244,7 +247,7 @@ ErlNifEnv* enif_alloc_env(void)
msg_env->env.hp_end = phony_heap;
msg_env->env.heap_frag = NULL;
msg_env->env.mod_nif = NULL;
- msg_env->env.tmp_obj_list = (struct enif_tmp_obj_t*) 1; /* invalid non-NULL */
+ msg_env->env.tmp_obj_list = NULL;
msg_env->env.proc = &msg_env->phony_proc;
memset(&msg_env->phony_proc, 0, sizeof(Process));
HEAP_START(&msg_env->phony_proc) = phony_heap;
@@ -289,6 +292,7 @@ void enif_clear_env(ErlNifEnv* env)
menv->env.hp = menv->env.hp_end = HEAP_TOP(p);
ASSERT(!is_offheap(&MSO(p)));
+ free_tmp_objs(env);
}
int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErlNifEnv* msg_env, ERL_NIF_TERM msg)
@@ -435,24 +439,36 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)
return term == THE_NON_VALUE;
}
+int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return is_number(term);
+}
+
+static ERTS_INLINE int is_proc_bound(ErlNifEnv* env)
+{
+ return env->mod_nif != NULL;
+}
+
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
- erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP);
+ erts_free_aligned_binary_bytes_extra((byte*)obj, obj->allocator);
}
int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
{
+ ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
union {
struct enif_tmp_obj_t* tmp;
byte* raw_ptr;
}u;
u.tmp = NULL;
- bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, ERTS_ALC_T_TMP,
+ bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator,
sizeof(struct enif_tmp_obj_t));
if (bin->data == NULL) {
return 0;
}
if (u.tmp != NULL) {
+ u.tmp->allocator = allocator;
u.tmp->next = env->tmp_obj_list;
u.tmp->dtor = &aligned_binary_dtor;
env->tmp_obj_list = u.tmp;
@@ -466,12 +482,13 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin)
static void tmp_alloc_dtor(struct enif_tmp_obj_t* obj)
{
- erts_free(ERTS_ALC_T_TMP, obj);
+ erts_free(obj->allocator, obj);
}
int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
{
struct enif_tmp_obj_t* tobj;
+ ErtsAlcType_t allocator;
Uint sz;
if (is_binary(term)) {
return enif_inspect_binary(env,term,bin);
@@ -486,8 +503,10 @@ int enif_inspect_iolist_as_binary(ErlNifEnv* env, Eterm term, ErlNifBinary* bin)
if (erts_iolist_size(term, &sz)) {
return 0;
}
-
- tobj = erts_alloc(ERTS_ALC_T_TMP, sz + sizeof(struct enif_tmp_obj_t));
+
+ allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
+ tobj = erts_alloc(allocator, sz + sizeof(struct enif_tmp_obj_t));
+ tobj->allocator = allocator;
tobj->next = env->tmp_obj_list;
tobj->dtor = &tmp_alloc_dtor;
env->tmp_obj_list = tobj;
@@ -676,6 +695,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
ErlSubBin* sb;
Eterm orig;
Uint offset, bit_offset, bit_size;
+#ifdef DEBUG
unsigned src_size;
ASSERT(is_binary(bin_term));
@@ -683,6 +703,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term,
ASSERT(pos <= src_size);
ASSERT(size <= src_size);
ASSERT(pos + size <= src_size);
+#endif
sb = (ErlSubBin*) alloc_heap(env, ERL_SUB_BIN_SIZE);
ERTS_GET_REAL_BIN(bin_term, orig, offset, bit_offset, bit_size);
sb->thing_word = HEADER_SUB_BIN;
@@ -1021,6 +1042,29 @@ void enif_system_info(ErlNifSysInfo *sip, size_t si_size)
driver_system_info(sip, si_size);
}
+int enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list) {
+ Eterm *listptr, ret = NIL, *hp;
+
+ if (is_nil(term)) {
+ *list = term;
+ return 1;
+ }
+
+ ret = NIL;
+
+ while (is_not_nil(term)) {
+ if (is_not_list(term)) {
+ return 0;
+ }
+ hp = alloc_heap(env, 2);
+ listptr = list_val(term);
+ ret = CONS(hp, CAR(listptr), ret);
+ term = CDR(listptr);
+ }
+ *list = ret;
+ return 1;
+}
+
ErlNifMutex* enif_mutex_create(char *name) { return erl_drv_mutex_create(name); }
void enif_mutex_destroy(ErlNifMutex *mtx) { erl_drv_mutex_destroy(mtx); }
@@ -1715,8 +1759,10 @@ struct readonly_check_t
};
static void add_readonly_check(ErlNifEnv* env, unsigned char* ptr, unsigned sz)
{
- struct readonly_check_t* obj = erts_alloc(ERTS_ALC_T_TMP,
+ ErtsAlcType_t allocator = is_proc_bound(env) ? ERTS_ALC_T_TMP : ERTS_ALC_T_NIF;
+ struct readonly_check_t* obj = erts_alloc(allocator,
sizeof(struct readonly_check_t));
+ obj->hdr.allocator = allocator;
obj->hdr.next = env->tmp_obj_list;
env->tmp_obj_list = &obj->hdr;
obj->hdr.dtor = &readonly_check_dtor;
@@ -1733,7 +1779,7 @@ static void readonly_check_dtor(struct enif_tmp_obj_t* o)
" %x != %x\r\nABORTING\r\n", chksum, obj->checksum);
abort();
}
- erts_free(ERTS_ALC_T_TMP, obj);
+ erts_free(obj->hdr.allocator, obj);
}
static unsigned calc_checksum(unsigned char* ptr, unsigned size)
{
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index d028567faf..fea527f954 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -32,9 +32,10 @@
** 2.0: R14A
** 2.1: R14B02 "vm_variant"
** 2.2: R14B03 enif_is_exception
+** 2.3: R15 enif_make_reverse_list
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 2
+#define ERL_NIF_MINOR_VERSION 3
#include <stdlib.h>
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index c991b61abe..6396af09d0 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -136,6 +136,8 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
#endif
ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
+ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list));
+ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term));
/*
** Add new entries here to keep compatibility on Windows!!!
@@ -256,12 +258,207 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
#endif
# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
+# define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list)
+# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number)
/*
** Add new entries here
*/
#endif
+
+#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+
+/* Inline functions for compile time type checking of arguments to
+ variadic functions.
+*/
+
+# define ERL_NIF_INLINE __inline__
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env,
+ ERL_NIF_TERM e1)
+{
+ return enif_make_tuple(env, 1, e1);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2)
+{
+ return enif_make_tuple(env, 2, e1, e2);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3)
+{
+ return enif_make_tuple(env, 3, e1, e2, e3);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4)
+{
+ return enif_make_tuple(env, 4, e1, e2, e3, e4);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5)
+{
+ return enif_make_tuple(env, 5, e1, e2, e3, e4, e5);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6)
+{
+ return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7)
+{
+ return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8)
+{
+ return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8,
+ ERL_NIF_TERM e9)
+{
+ return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env,
+ ERL_NIF_TERM e1)
+{
+ return enif_make_list(env, 1, e1);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2)
+{
+ return enif_make_list(env, 2, e1, e2);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3)
+{
+ return enif_make_list(env, 3, e1, e2, e3);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4)
+{
+ return enif_make_list(env, 4, e1, e2, e3, e4);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5)
+{
+ return enif_make_list(env, 5, e1, e2, e3, e4, e5);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6)
+{
+ return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7)
+{
+ return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8)
+{
+ return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8);
+}
+
+static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env,
+ ERL_NIF_TERM e1,
+ ERL_NIF_TERM e2,
+ ERL_NIF_TERM e3,
+ ERL_NIF_TERM e4,
+ ERL_NIF_TERM e5,
+ ERL_NIF_TERM e6,
+ ERL_NIF_TERM e7,
+ ERL_NIF_TERM e8,
+ ERL_NIF_TERM e9)
+{
+ return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9);
+}
+
+# undef ERL_NIF_INLINE
+
+#else /* fallback with macros */
+
#ifndef enif_make_list1
# define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1)
# define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2)
@@ -281,6 +478,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
# define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7)
# define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8)
# define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9)
+#endif
+
+#endif /* __GNUC__ && !WIN32 */
+
+#ifndef enif_make_pid
# define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid))
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 4dda17f559..9792cd4da2 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -3318,11 +3318,14 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online)
erts_bits_init_state(&esdp->erl_bits_state);
esdp->match_pseudo_process = NULL;
esdp->free_process = NULL;
-#if HALFWORD_HEAP
- /* Registers need to be heap allocated (correct memory range) for tracing to work */
- esdp->save_reg = erts_alloc(ERTS_ALC_T_BEAM_REGISTER, ERTS_X_REGS_ALLOCATED * sizeof(Eterm));
-#endif
#endif
+ esdp->x_reg_array =
+ erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
+ ERTS_X_REGS_ALLOCATED *
+ sizeof(Eterm));
+ esdp->f_reg_array =
+ erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
+ MAX_REG * sizeof(FloatDef));
#if !HEAP_ON_C_STACK
esdp->num_tmp_heap_used = 0;
#endif
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 43593f32d9..f6815660f3 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -415,19 +415,15 @@ typedef struct {
} ErtsAuxWorkData;
struct ErtsSchedulerData_ {
-
-#ifdef ERTS_SMP
/*
* Keep X registers first (so we get as many low
* numbered registers as possible in the same cache
* line).
*/
-#if !HALFWORD_HEAP
- Eterm save_reg[ERTS_X_REGS_ALLOCATED]; /* X registers */
-#else
- Eterm *save_reg;
-#endif
- FloatDef freg[MAX_REG]; /* Floating point registers. */
+ Eterm* x_reg_array; /* X registers */
+ FloatDef* f_reg_array; /* Floating point registers. */
+
+#ifdef ERTS_SMP
ethr_tid tid; /* Thread id */
struct erl_bits_state erl_bits_state; /* erl_bits.c state */
void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index 83379d7352..b4d20480c5 100644
--- a/erts/emulator/beam/erl_process_lock.c
+++ b/erts/emulator/beam/erl_process_lock.c
@@ -669,7 +669,9 @@ proc_safelock(Process *a_proc,
ErtsProcLocks b_need_locks)
{
Process *p1, *p2;
+#ifdef ERTS_ENABLE_LOCK_CHECK
Eterm pid1, pid2;
+#endif
erts_pix_lock_t *pix_lck1, *pix_lck2;
ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2;
ErtsProcLocks unlock_mask;
@@ -684,24 +686,32 @@ proc_safelock(Process *a_proc,
if (a_proc) {
if (a_proc->id < b_proc->id) {
p1 = a_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = a_proc->id;
+#endif
pix_lck1 = a_pix_lck;
need_locks1 = a_need_locks;
have_locks1 = a_have_locks;
p2 = b_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = b_proc->id;
+#endif
pix_lck2 = b_pix_lck;
need_locks2 = b_need_locks;
have_locks2 = b_have_locks;
}
else if (a_proc->id > b_proc->id) {
p1 = b_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = b_proc->id;
+#endif
pix_lck1 = b_pix_lck;
need_locks1 = b_need_locks;
have_locks1 = b_have_locks;
p2 = a_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = a_proc->id;
+#endif
pix_lck2 = a_pix_lck;
need_locks2 = a_need_locks;
have_locks2 = a_have_locks;
@@ -710,12 +720,16 @@ proc_safelock(Process *a_proc,
ERTS_LC_ASSERT(a_proc == b_proc);
ERTS_LC_ASSERT(a_proc->id == b_proc->id);
p1 = a_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = a_proc->id;
+#endif
pix_lck1 = a_pix_lck;
need_locks1 = a_need_locks | b_need_locks;
have_locks1 = a_have_locks | b_have_locks;
p2 = NULL;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = 0;
+#endif
pix_lck2 = NULL;
need_locks2 = 0;
have_locks2 = 0;
@@ -723,12 +737,16 @@ proc_safelock(Process *a_proc,
}
else {
p1 = b_proc;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid1 = b_proc->id;
+#endif
pix_lck1 = b_pix_lck;
need_locks1 = b_need_locks;
have_locks1 = b_have_locks;
p2 = NULL;
+#ifdef ERTS_ENABLE_LOCK_CHECK
pid2 = 0;
+#endif
pix_lck2 = NULL;
need_locks2 = 0;
have_locks2 = 0;
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 1d75fa313c..bc20b2d798 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -331,7 +331,13 @@ _ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm)
* we now use a non-zero bit-pattern in debug mode.
*/
#if ET_DEBUG
-#define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT)
+# ifdef HIPE
+ /* A very large (or negative) value as work-around for ugly hipe-bifs
+ that return untagged integers (eg hipe_bs_put_utf8) */
+# define THE_NON_VALUE _make_header((Uint)~0,_TAG_HEADER_FLOAT)
+# else
+# define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT)
+# endif
#else
#define THE_NON_VALUE (0)
#endif
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 8833137112..39509f363f 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2092,8 +2092,7 @@ void save_calls(Process *p, Export *e)
* entries instead of the original BIF functions.
*/
Eterm
-erts_bif_trace(int bif_index, Process* p,
- Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I)
+erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I)
{
Eterm result;
int meta = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_META);
@@ -2107,10 +2106,10 @@ erts_bif_trace(int bif_index, Process* p,
* no tracing will occur. Doing the whole else branch will
* also do nothing, only slower.
*/
- Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*) = bif_table[bif_index].f;
- result = func(p, arg1, arg2, arg3, I);
+ Eterm (*func)(Process*, Eterm*, BeamInstr*) = bif_table[bif_index].f;
+ result = func(p, args, I);
} else {
- Eterm (*func)(Process*, Eterm, Eterm, Eterm, BeamInstr*);
+ Eterm (*func)(Process*, Eterm*, BeamInstr*);
Export* ep = bif_export[bif_index];
Uint32 flags = 0, flags_meta = 0;
int global = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_GLOBAL);
@@ -2122,8 +2121,6 @@ erts_bif_trace(int bif_index, Process* p,
* export entry */
BeamInstr *cp = p->cp;
- Eterm args[3] = {arg1, arg2, arg3};
-
/*
* Make continuation pointer OK, it is not during direct BIF calls,
* but it is correct during apply of bif.
@@ -2155,7 +2152,7 @@ erts_bif_trace(int bif_index, Process* p,
func = bif_table[bif_index].f;
- result = func(p, arg1, arg2, arg3, I);
+ result = func(p, args, I);
if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) {
BeamInstr i_return_trace = beam_return_trace[0];
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 158eb361a4..fca785a4de 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -47,7 +47,7 @@ typedef struct _restart_context {
static Uint max_loop_limit;
-static BIF_RETTYPE utf8_to_list(BIF_ALIST_1);
+static BIF_RETTYPE utf8_to_list(Process *p, Eterm arg1);
static BIF_RETTYPE finalize_list_to_list(Process *p,
byte *bytes,
Eterm rest,
@@ -348,12 +348,6 @@ static int copy_utf8_bin(byte *target, byte *source, Uint size,
return copied;
}
- if (((*source) == 0xEF) && (source[1] == 0xBF) &&
- ((source[2] == 0xBE) || (source[2] == 0xBF))) {
- *err_pos = source;
- return copied;
- }
-
*(target++) = *(source++);
*(target++) = *(source++);
*(target++) = *(source++);
@@ -714,9 +708,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
target[(*pos)++] = (((byte) (x & 0x3F)) |
((byte) 0x80));
} else if (x < 0x10000) {
- if ((x >= 0xD800 && x <= 0xDFFF) ||
- (x == 0xFFFE) ||
- (x == 0xFFFF)) { /* Invalid unicode range */
+ if (x >= 0xD800 && x <= 0xDFFF) {
+ /* Invalid unicode range */
*err = 1;
goto done;
}
@@ -1230,10 +1223,6 @@ int erts_analyze_utf8(byte *source, Uint size,
((source[1] & 0x20) != 0)) {
return ERTS_UTF8_ERROR;
}
- if (((*source) == 0xEF) && (source[1] == 0xBF) &&
- ((source[2] == 0xBE) || (source[2] == 0xBF))) {
- return ERTS_UTF8_ERROR;
- }
source += 3;
size -= 3;
} else if (((*source) & ((byte) 0xF8)) == 0xF0) {
@@ -1839,13 +1828,13 @@ static BIF_RETTYPE characters_to_list_trap_4(BIF_ALIST_1)
* Instead of building an utf8 buffer, we analyze the binary given and use that.
*/
-static BIF_RETTYPE utf8_to_list(BIF_ALIST_1)
+static BIF_RETTYPE utf8_to_list(Process* p, Eterm arg)
{
- if (!is_binary(BIF_ARG_1) || aligned_binary_size(BIF_ARG_1) < 0) {
- BIF_ERROR(BIF_P,BADARG);
+ if (!is_binary(arg) || aligned_binary_size(arg) < 0) {
+ BIF_ERROR(p, BADARG);
}
- return do_bif_utf8_to_list(BIF_P, BIF_ARG_1, 0U, 0U, 0U,
- ERTS_UTF8_ANALYZE_MORE,NIL);
+ return do_bif_utf8_to_list(p, arg, 0U, 0U, 0U,
+ ERTS_UTF8_ANALYZE_MORE, NIL);
}
@@ -2166,9 +2155,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
} else if (x < 0x800) {
need += 2;
} else if (x < 0x10000) {
- if ((x >= 0xD800 && x <= 0xDFFF) ||
- (x == 0xFFFE) ||
- (x == 0xFFFF)) { /* Invalid unicode range */
+ if (x >= 0xD800 && x <= 0xDFFF) {
+ /* Invalid unicode range */
DESTROY_ESTACK(stack);
return ((Sint) -1);
}
@@ -2314,9 +2302,7 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */
*p++ = (((byte) (x & 0x3F)) |
((byte) 0x80));
} else if (x < 0x10000) {
- ASSERT(!((x >= 0xD800 && x <= 0xDFFF) ||
- (x == 0xFFFE) ||
- (x == 0xFFFF)));
+ ASSERT(!(x >= 0xD800 && x <= 0xDFFF));
*p++ = (((byte) (x >> 12)) |
((byte) 0xE0));
*p++ = ((((byte) (x >> 6)) & 0x3F) |
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index e7fd144ec3..f810392e60 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -55,7 +55,7 @@
heap data on the C stack or if we use the buffers in the scheduler data. */
#define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers
small heap for transient heap data */
-#define CMP_TMP_HEAP_SIZE 2 /* cmp wants its own tmp-heap... */
+#define CMP_TMP_HEAP_SIZE 32 /* cmp wants its own tmp-heap... */
#define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */
#define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 6953e7fe7d..80ce4b969c 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -988,16 +988,16 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
}
-Eterm
-term_to_binary_1(Process* p, Eterm Term)
+BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
{
- return erts_term_to_binary(p, Term, 0, TERM_TO_BINARY_DFLAGS);
+ return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS);
}
-
-Eterm
-term_to_binary_2(Process* p, Eterm Term, Eterm Flags)
+BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
{
+ Process* p = BIF_P;
+ Eterm Term = BIF_ARG_1;
+ Eterm Flags = BIF_ARG_2;
int level = 0;
Uint flags = TERM_TO_BINARY_DFLAGS;
@@ -1256,8 +1256,11 @@ BIF_RETTYPE binary_to_term_2(BIF_ALIST_2)
}
Eterm
-external_size_1(Process* p, Eterm Term)
+external_size_1(BIF_ALIST_1)
{
+ Process* p = BIF_P;
+ Eterm Term = BIF_ARG_1;
+
Uint size = erts_encode_ext_size(Term);
if (IS_USMALL(0, size)) {
BIF_RET(make_small(size));
@@ -1268,13 +1271,13 @@ external_size_1(Process* p, Eterm Term)
}
Eterm
-external_size_2(Process* p, Eterm Term, Eterm Flags)
+external_size_2(BIF_ALIST_2)
{
Uint size;
Uint flags = TERM_TO_BINARY_DFLAGS;
- while (is_list(Flags)) {
- Eterm arg = CAR(list_val(Flags));
+ while (is_list(BIF_ARG_2)) {
+ Eterm arg = CAR(list_val(BIF_ARG_2));
Eterm* tp;
if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) {
@@ -1293,19 +1296,19 @@ external_size_2(Process* p, Eterm Term, Eterm Flags)
}
} else {
error:
- BIF_ERROR(p, BADARG);
+ BIF_ERROR(BIF_P, BADARG);
}
- Flags = CDR(list_val(Flags));
+ BIF_ARG_2 = CDR(list_val(BIF_ARG_2));
}
- if (is_not_nil(Flags)) {
+ if (is_not_nil(BIF_ARG_2)) {
goto error;
}
- size = erts_encode_ext_size_2(Term, flags);
+ size = erts_encode_ext_size_2(BIF_ARG_1, flags);
if (IS_USMALL(0, size)) {
BIF_RET(make_small(size));
} else {
- Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE);
+ Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
BIF_RET(uint_to_big(size, hp));
}
}
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 6687e02485..684e910fc3 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -37,6 +37,7 @@
#include "erl_process.h"
#include "erl_sys_driver.h"
#include "erl_debug.h"
+#include "error.h"
typedef struct port Port;
#include "erl_port_task.h"
@@ -851,18 +852,35 @@ void erts_queue_monitor_message(Process *,
Eterm,
Eterm);
void erts_init_bif(void);
+Eterm erl_send(Process *p, Eterm to, Eterm msg);
+
+/* erl_bif_op.c */
+
+Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
/* erl_bif_port.c */
/* erl_bif_trace.c */
+Eterm erl_seq_trace_info(Process *p, Eterm arg1);
void erts_system_monitor_clear(Process *c_p);
void erts_system_profile_clear(Process *c_p);
/* beam_load.c */
+typedef struct {
+ BeamInstr* current; /* Pointer to: Mod, Name, Arity */
+ Uint needed; /* Heap space needed for entire tuple */
+ Uint32 loc; /* Location in source code */
+ Eterm* fname_ptr; /* Pointer to fname table */
+} FunctionInfo;
+
int erts_load_module(Process *c_p, ErtsProcLocks c_p_locks,
Eterm group_leader, Eterm* mod, byte* code, int size);
void init_load(void);
BeamInstr* find_function_from_pc(BeamInstr* pc);
+Eterm* erts_build_mfa_item(FunctionInfo* fi, Eterm* hp,
+ Eterm args, Eterm* mfa_p);
+void erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info);
+void erts_set_current_function(FunctionInfo* fi, BeamInstr* current);
Eterm erts_module_info_0(Process* p, Eterm module);
Eterm erts_module_info_1(Process* p, Eterm module, Eterm what);
Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info);
@@ -1053,6 +1071,7 @@ void init_emulator(void);
void process_main(void);
Eterm build_stacktrace(Process* c_p, Eterm exc);
Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value);
+void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth);
/* erl_init.c */
@@ -1074,6 +1093,7 @@ extern ErtsModifiedTimings erts_modified_timings[];
#define ERTS_MODIFIED_TIMING_INPUT_REDS \
(erts_modified_timings[erts_modified_timing_level].input_reds)
+extern int erts_no_line_info;
extern Eterm erts_error_logger_warnings;
extern int erts_initialized;
extern int erts_compat_rel;
@@ -1627,8 +1647,7 @@ void monitor_generic(Process *p, Eterm type, Eterm spec);
Uint erts_trace_flag2bit(Eterm flag);
int erts_trace_flags(Eterm List,
Uint *pMask, Eterm *pTracer, int *pCpuTimestamp);
-Eterm erts_bif_trace(int bif_index, Process* p,
- Eterm arg1, Eterm arg2, Eterm arg3, BeamInstr *I);
+Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I);
#ifdef ERTS_SMP
void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp);
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 304ce22ef2..fc53a88a3a 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -25,30 +25,12 @@
# instruction transformations; thus, they never occur in BEAM files.
#
-# Special instruction used to generate an error message when
-# trying to load a module compiled by the V1 compiler (R5 & R6).
-# (Specially treated in beam_load.c.)
+# The too_old_compiler/0 instruction is specially handled in beam_load.c
+# to produce a user-friendly message informing the user that the module
+# needs to be re-compiled with a modern compiler.
too_old_compiler/0
-too_old_compiler
-
-#
-# Obsolete instruction usage follow. (Nowdays we use f with
-# a zero label instead of p.)
-#
-
-is_list p S => too_old_compiler
-is_nonempty_list p R => too_old_compiler
-is_nil p R => too_old_compiler
-
-is_tuple p S => too_old_compiler
-test_arity p S Arity => too_old_compiler
-
-is_integer p R => too_old_compiler
-is_float p R => too_old_compiler
-is_atom p R => too_old_compiler
-
-is_eq_exact p S1 S2 => too_old_compiler
+too_old_compiler | never() =>
# In R9C and earlier, the loader used to insert special instructions inside
# the module_info/0,1 functions. (In R10B and later, the compiler inserts
@@ -88,12 +70,42 @@ i_time_breakpoint
i_return_time_trace
i_return_to_trace
i_yield
-i_global_cons
-i_global_tuple
-i_global_copy
return
+#
+# To ensure that a "move Src x(0)" instruction can be combined
+# with the following call instruction, we need to make sure that
+# there is no line/1 instruction between the move and the call.
+#
+
+move S r | line Loc | call_ext Ar Func => \
+ line Loc | move S r | call_ext Ar Func
+move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \
+ line Loc | move S r | call_ext_last Ar Func D
+move S r | line Loc | call_ext_only Ar Func=u$is_bif => \
+ line Loc | move S r | call_ext_only Ar Func
+move S r | line Loc | call Ar Func => \
+ line Loc | move S r | call Ar Func
+
+#
+# A tail-recursive call to an external function (non-BIF) will
+# never be saved on the stack, so there is no reason to keep
+# the line instruction. (The compiler did not remove the line
+# instruction because it cannot tell the difference between
+# BIFs and ordinary Erlang functions.)
+#
+
+line Loc | call_ext_last Ar Func=u$is_not_bif D => \
+ call_ext_last Ar Func D
+line Loc | call_ext_only Ar Func=u$is_not_bif => \
+ call_ext_only Ar Func
+
+line Loc | func_info M F A => func_info M F A | line Loc
+
+line I
+
+
%macro: allocate Allocate -pack
%macro: allocate_zero AllocateZero -pack
%macro: allocate_heap AllocateHeap -pack
@@ -277,8 +289,6 @@ raise s s
badarg j
system_limit j
-move R R =>
-
move C=cxy r | jump Lbl => move_jump Lbl C
%macro: move_jump MoveJump -nonext
@@ -585,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg
original_reg Reg Pos =>
-get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
-
original_reg/2
extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
@@ -837,11 +845,11 @@ call_ext_only u==3 u$func:erlang:apply/3 => i_apply_only
# thus there is no need to generate any return instruction.
#
-call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif1 Bif
-call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif1 Bif
+call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif Bif
+call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif Bif
-call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif1 Bif
-call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif
+call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif Bif
+call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif Bif
#
# The error/1 and error/2 BIFs never execute the instruction following them;
@@ -851,13 +859,13 @@ call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif
# the continuation pointer on the stack.
#
-call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif1 Bif
-call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif2 Bif
+call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif Bif
+call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif Bif
call_ext_only Ar=u==1 Bif=u$bif:erlang:error/1 => \
- allocate u Ar | call_bif1 Bif
+ allocate u Ar | call_bif Bif
call_ext_only Ar=u==2 Bif=u$bif:erlang:error/2 => \
- allocate u Ar | call_bif2 Bif
+ allocate u Ar | call_bif Bif
#
# The yield/0 BIF is an instruction
@@ -875,47 +883,18 @@ call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate
call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate
#
-# Hybrid memory architecture need special cons and tuple instructions
-# that allocate on the message area. These looks like BIFs in the BEAM code.
-#
-
-call_ext u==2 u$func:hybrid:cons/2 => i_global_cons
-call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D
-call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return
-
-call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple
-call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D
-call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return
-
-call_ext u==1 u$func:hybrid:copy/1 => i_global_copy
-call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D
-call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return
-
-#
# The general case for BIFs that have no special instructions.
# A BIF used in the tail must be followed by a return instruction.
#
# To make trapping and stack backtraces work correctly, we make sure that
# the continuation pointer is always stored on the stack.
-call_ext u==0 Bif=u$is_bif => call_bif0 Bif
-call_ext u==1 Bif=u$is_bif => call_bif1 Bif
-call_ext u==2 Bif=u$is_bif => call_bif2 Bif
-call_ext u==3 Bif=$is_bif => call_bif3 Bif
+call_ext u Bif=u$is_bif => call_bif Bif
-call_ext_last u==0 Bif=u$is_bif D => call_bif0 Bif | deallocate_return D
-call_ext_last u==1 Bif=u$is_bif D => call_bif1 Bif | deallocate_return D
-call_ext_last u==2 Bif=u$is_bif D => call_bif2 Bif | deallocate_return D
-call_ext_last u==3 Bif=u$is_bif D => call_bif3 Bif | deallocate_return D
+call_ext_last u Bif=u$is_bif D => call_bif Bif | deallocate_return D
-call_ext_only Ar=u==0 Bif=u$is_bif => \
- allocate u Ar | call_bif0 Bif | deallocate_return u
-call_ext_only Ar=u==1 Bif=u$is_bif => \
- allocate u Ar | call_bif1 Bif | deallocate_return u
-call_ext_only Ar=u==2 Bif=u$is_bif => \
- allocate u Ar | call_bif2 Bif | deallocate_return u
-call_ext_only Ar=u==3 Bif=u$is_bif => \
- allocate u Ar | call_bif3 Bif | deallocate_return u
+call_ext_only Ar=u Bif=u$is_bif => \
+ allocate u Ar | call_bif Bif | deallocate_return u
#
# Any remaining calls are calls to Erlang functions, not BIFs.
@@ -928,9 +907,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func
move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r
move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r
-call_ext Ar=u Func => i_call_ext Func
-call_ext_last Ar=u Func D => i_call_ext_last Func D
-call_ext_only Ar=u Func => i_call_ext_only Func
+call_ext Ar Func => i_call_ext Func
+call_ext_last Ar Func D => i_call_ext_last Func D
+call_ext_only Ar Func => i_call_ext_only Func
i_apply
i_apply_last P
@@ -942,10 +921,7 @@ i_apply_fun_only
i_hibernate
-call_bif0 e
-call_bif1 e
-call_bif2 e
-call_bif3 e
+call_bif e
#
# Calls to non-building and guard BIFs.
@@ -964,7 +940,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst
bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst
bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst
-bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
+bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
i_get s d
@@ -1047,8 +1023,8 @@ i_move_call_ext_only e c r
# Fun calls.
-call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D
-call_fun Arity=u => i_call_fun Arity
+call_fun Arity | deallocate D | return => i_call_fun_last Arity D
+call_fun Arity => i_call_fun Arity
i_call_fun I
i_call_fun_last I P
@@ -1304,13 +1280,13 @@ i_bs_utf16_size s d
bs_put_utf8 Fail=j Flags=u Literal=q => \
move Literal x | bs_put_utf8 Fail Flags x
-bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src
+bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
i_bs_put_utf8 j s
bs_put_utf16 Fail=j Flags=u Literal=q => \
move Literal x | bs_put_utf16 Fail Flags x
-bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
+bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
i_bs_put_utf16 j I s
@@ -1475,34 +1451,13 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler
#
# Guard BIFs.
#
-gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \
+gc_bif1 Fail I Bif Src Dst => \
gen_guard_bif1(Fail, I, Bif, Src, Dst)
-gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
-
-gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \
+gc_bif2 Fail I Bif S1 S2 Dst => \
gen_guard_bif2(Fail, I, Bif, S1, S2, Dst)
-gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \
+gc_bif3 Fail I Bif S1 S2 S3 Dst => \
gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D
@@ -1520,6 +1475,15 @@ ii_gc_bif3/7
ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D
i_gc_bif3 j I s I d
+
+#
+# The following instruction is specially handled in beam_load.c
+# to produce a user-friendly message if an unsupported guard BIF is
+# encountered.
+#
+unsupported_guard_bif/3
+unsupported_guard_bif A B C | never() =>
+
#
# R13B03
#
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 3fa84bd13c..2d621e8be6 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -2644,7 +2644,7 @@ tailrecur_ne:
FloatDef f1, f2;
Eterm big;
#if HEAP_ON_C_STACK
- Eterm big_buf[2]; /* If HEAP_ON_C_STACK */
+ Eterm big_buf[32]; /* If HEAP_ON_C_STACK */
#else
Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap;
#endif
@@ -2655,41 +2655,108 @@ tailrecur_ne:
Eterm aw = a;
Eterm bw = b;
#endif
+#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2))
+#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1))
b_tag = tag_val_def(bw);
switch(_NUMBER_CODE(a_tag, b_tag)) {
case SMALL_BIG:
- big = small_to_big(signed_val(a), big_buf);
- j = big_comp(big, bw);
+ j = big_sign(bw) ? 1 : -1;
+ break;
+ case BIG_SMALL:
+ j = big_sign(aw) ? -1 : 1;
break;
case SMALL_FLOAT:
- f1.fd = signed_val(a);
GET_DOUBLE(bw, f2);
- j = float_comp(f1.fd, f2.fd);
- break;
- case BIG_SMALL:
- big = small_to_big(signed_val(b), big_buf);
- j = big_comp(aw, big);
+ if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ f1.fd = signed_val(aw);
+ j = float_comp(f1.fd, f2.fd);
+#if ERTS_SIZEOF_ETERM == 8
+ } else if (f2.fd > (double) (MAX_SMALL + 1)) {
+ // Float is a positive bignum, i.e. bigger
+ j = -1;
+ } else if (f2.fd < (double) (MIN_SMALL - 1)) {
+ // Float is a negative bignum, i.e. smaller
+ j = 1;
+ } else { // Float is a Sint but less precise
+ j = signed_val(aw) - (Sint) f2.fd;
+ }
+#else
+ } else {
+ // If float is positive it is bigger than small
+ j = (f2.fd > 0.0) ? -1 : 1;
+ }
+#endif // ERTS_SIZEOF_ETERM == 8
break;
case BIG_FLOAT:
- if (big_to_double(aw, &f1.fd) < 0) {
- j = big_sign(a) ? -1 : 1;
+ GET_DOUBLE(bw, f2);
+ if ((f2.fd < (double) (MAX_SMALL + 1))
+ && (f2.fd > (double) (MIN_SMALL - 1))) {
+ // Float is a Sint
+ j = big_sign(aw) ? -1 : 1;
+ } else if ((pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) {
+ // If bignum size shows that it is bigger than the abs float
+ j = big_sign(aw) ? -1 : 1;
+ } else if ((pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) {
+ // If bignum size shows that it is smaller than the abs float
+ j = f2.fd < 0 ? 1 : -1;
+ } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ if (big_to_double(aw, &f1.fd) < 0) {
+ j = big_sign(aw) ? -1 : 1;
+ } else {
+ j = float_comp(f1.fd, f2.fd);
+ }
} else {
- GET_DOUBLE(bw, f2);
- j = float_comp(f1.fd, f2.fd);
+ big = double_to_big(f2.fd, big_buf);
+ j = big_comp(aw, big);
}
break;
case FLOAT_SMALL:
GET_DOUBLE(aw, f1);
- f2.fd = signed_val(b);
- j = float_comp(f1.fd, f2.fd);
+ if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ f2.fd = signed_val(bw);
+ j = float_comp(f1.fd, f2.fd);
+#if ERTS_SIZEOF_ETERM == 8
+ } else if (f1.fd > (double) (MAX_SMALL + 1)) {
+ // Float is a positive bignum, i.e. bigger
+ j = 1;
+ } else if (f1.fd < (double) (MIN_SMALL - 1)) {
+ // Float is a negative bignum, i.e. smaller
+ j = -1;
+ } else { // Float is a Sint but less precise it
+ j = (Sint) f1.fd - signed_val(bw);
+ }
+#else
+ } else {
+ // If float is positive it is bigger than small
+ j = (f1.fd > 0.0) ? 1 : -1;
+ }
+#endif // ERTS_SIZEOF_ETERM == 8
break;
case FLOAT_BIG:
- if (big_to_double(bw, &f2.fd) < 0) {
- j = big_sign(b) ? 1 : -1;
+ GET_DOUBLE(aw, f1);
+ if ((f1.fd < (double) (MAX_SMALL + 1))
+ && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint
+ j = big_sign(bw) ? 1 : -1;
+ } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) {
+ // If bignum size shows that it is bigger than the abs float
+ j = big_sign(bw) ? 1 : -1;
+ } else if ((pow(2.0,(big_arity(bw))*D_EXP)-1.0) < fabs(f1.fd)) {
+ // If bignum size shows that it is smaller than the abs float
+ j = f1.fd < 0 ? -1 : 1;
+ } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) {
+ // Float is within the no loss limit
+ if (big_to_double(bw, &f2.fd) < 0) {
+ j = big_sign(bw) ? 1 : -1;
+ } else {
+ j = float_comp(f1.fd, f2.fd);
+ }
} else {
- GET_DOUBLE(aw, f1);
- j = float_comp(f1.fd, f2.fd);
+ big = double_to_big(f1.fd, big_buf);
+ j = big_comp(big, bw);
}
break;
default: