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.c96
-rw-r--r--erts/emulator/beam/beam_bp.c20
-rw-r--r--erts/emulator/beam/beam_bp.h17
-rw-r--r--erts/emulator/beam/beam_catches.c46
-rw-r--r--erts/emulator/beam/beam_debug.c27
-rw-r--r--erts/emulator/beam/beam_emu.c630
-rw-r--r--erts/emulator/beam/beam_load.c1440
-rw-r--r--erts/emulator/beam/beam_load.h15
-rw-r--r--erts/emulator/beam/bif.c189
-rw-r--r--erts/emulator/beam/bif.h155
-rw-r--r--erts/emulator/beam/big.c68
-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/copy.c2
-rw-r--r--erts/emulator/beam/dist.c53
-rw-r--r--erts/emulator/beam/erl_alloc.c18
-rw-r--r--erts/emulator/beam/erl_arith.c8
-rw-r--r--erts/emulator/beam/erl_bif_binary.c78
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c137
-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.c75
-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.c166
-rw-r--r--erts/emulator/beam/erl_db_hash.c24
-rw-r--r--erts/emulator/beam/erl_db_hash.h3
-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.c54
-rw-r--r--erts/emulator/beam/erl_init.c34
-rw-r--r--erts/emulator/beam/erl_message.c4
-rw-r--r--erts/emulator/beam/erl_monitors.c8
-rw-r--r--erts/emulator/beam/erl_nif.c66
-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.c30
-rw-r--r--erts/emulator/beam/erl_process.h15
-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.c52
-rw-r--r--erts/emulator/beam/erl_vm.h2
-rw-r--r--erts/emulator/beam/external.c59
-rw-r--r--erts/emulator/beam/external.h4
-rw-r--r--erts/emulator/beam/global.h38
-rw-r--r--erts/emulator/beam/io.c6
-rw-r--r--erts/emulator/beam/ops.tab176
-rw-r--r--erts/emulator/beam/sys.h9
-rw-r--r--erts/emulator/beam/utils.c116
56 files changed, 3095 insertions, 1834 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 e6dba10fde..bc8c001454 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -40,6 +40,7 @@ static Eterm check_process_code(Process* rp, Module* modp);
static void delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp);
static void delete_export_references(Eterm module);
static int purge_module(int module);
+static void decrement_refc(BeamInstr* code);
static int is_native(BeamInstr* code);
static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -50,11 +51,11 @@ load_module_2(BIF_ALIST_2)
{
Eterm reason;
Eterm* hp;
- int i;
int sz;
byte* code;
Eterm res;
byte* temp_alloc = NULL;
+ struct LoaderState* stp;
if (is_not_atom(BIF_ARG_1)) {
error:
@@ -64,49 +65,37 @@ load_module_2(BIF_ALIST_2)
if ((code = erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc)) == NULL) {
goto error;
}
- erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erts_smp_thr_progress_block();
-
- erts_export_consolidate();
-
hp = HAlloc(BIF_P, 3);
+
+ /*
+ * Read the BEAM file and prepare the module for loading.
+ */
+ stp = erts_alloc_loader_state();
sz = binary_size(BIF_ARG_2);
- if ((i = erts_load_module(BIF_P, 0,
- BIF_P->group_leader, &BIF_ARG_1, code, sz)) < 0) {
- switch (i) {
- case -1: reason = am_badfile; break;
- case -2: reason = am_nofile; break;
- case -3: reason = am_not_purged; break;
- case -4:
- reason = am_atom_put("native_code", sizeof("native_code")-1);
- break;
- case -5:
- {
- /*
- * The module contains an on_load function. The loader
- * has loaded the module as usual, except that the
- * export entries does not point into the module, so it
- * is not possible to call any code in the module.
- */
-
- ERTS_DECL_AM(on_load);
- reason = AM_on_load;
- break;
- }
- default: reason = am_badfile; break;
- }
+ reason = erts_prepare_loading(stp, BIF_P, BIF_P->group_leader,
+ &BIF_ARG_1, code, sz);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ if (reason != NIL) {
res = TUPLE2(hp, am_error, reason);
- goto done;
+ BIF_RET(res);
}
- set_default_trace_pattern(BIF_ARG_1);
- res = TUPLE2(hp, am_module, BIF_ARG_1);
+ /*
+ * Stop all other processes and finish the loading of the module.
+ */
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
+ erts_smp_thr_progress_block();
+
+ reason = erts_finish_loading(stp, BIF_P, 0, &BIF_ARG_1);
+ if (reason != NIL) {
+ res = TUPLE2(hp, am_error, reason);
+ } else {
+ set_default_trace_pattern(BIF_ARG_1);
+ res = TUPLE2(hp, am_module, BIF_ARG_1);
+ }
- done:
- erts_free_aligned_binary_bytes(temp_alloc);
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
-
BIF_RET(res);
}
@@ -565,6 +554,7 @@ check_process_code(Process* rp, Module* modp)
} else {
Eterm* literals;
Uint lit_size;
+ struct erl_off_heap_header* oh;
/*
* Try to get rid of constants by by garbage collecting.
@@ -578,7 +568,9 @@ check_process_code(Process* rp, Module* modp)
(void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
literals = (Eterm *) modp->old_code[MI_LITERALS_START];
lit_size = (Eterm *) modp->old_code[MI_LITERALS_END] - literals;
- erts_garbage_collect_literals(rp, literals, lit_size);
+ oh = (struct erl_off_heap_header *)
+ modp->old_code[MI_LITERALS_OFF_HEAP];
+ erts_garbage_collect_literals(rp, literals, lit_size, oh);
}
}
return am_false;
@@ -656,9 +648,6 @@ purge_module(int module)
* Any code to purge?
*/
if (modp->old_code == 0) {
- if (display_loads) {
- erts_printf("No code to purge for %T\n", make_atom(module));
- }
return -1;
}
@@ -679,6 +668,7 @@ purge_module(int module)
end = (BeamInstr *)((char *)code + modp->old_code_length);
erts_cleanup_funs_on_purge(code, end);
beam_catches_delmod(modp->old_catches, code, modp->old_code_length);
+ decrement_refc(code);
erts_free(ERTS_ALC_T_CODE, (void *) code);
modp->old_code = NULL;
modp->old_code_length = 0;
@@ -688,6 +678,23 @@ purge_module(int module)
}
static void
+decrement_refc(BeamInstr* code)
+{
+ struct erl_off_heap_header* oh =
+ (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
+
+ while (oh) {
+ Binary* bptr;
+ ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
+ bptr = ((ProcBin*)oh)->val;
+ if (erts_refc_dectest(&bptr->refc, 0) == 0) {
+ erts_bin_free(bptr);
+ }
+ oh = oh->next;
+ }
+}
+
+static void
remove_from_address_table(BeamInstr* code)
{
int i;
@@ -774,7 +781,7 @@ delete_export_references(Eterm module)
}
-int
+Eterm
beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
{
Module* modp = erts_put_module(module);
@@ -785,15 +792,12 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
*/
if (modp->code != NULL && modp->old_code != NULL) {
- return -3;
+ return am_not_purged;
} else if (modp->old_code == NULL) { /* Make the current version old. */
- if (display_loads) {
- erts_printf("saving old code\n");
- }
delete_code(c_p, c_p_locks, modp);
delete_export_references(module);
}
- return 0;
+ return NIL;
}
static int
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 67748698e1..692fa61fe8 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -495,16 +495,6 @@ erts_find_local_func(Eterm mfa[3]) {
return NULL;
}
-/* bp_hash */
-ERTS_INLINE Uint bp_sched2ix() {
-#ifdef ERTS_SMP
- ErtsSchedulerData *esdp;
- esdp = erts_get_scheduler_data();
- return esdp->no - 1;
-#else
- return 0;
-#endif
-}
static void bp_hash_init(bp_time_hash_t *hash, Uint n) {
Uint size = sizeof(bp_data_time_item_t)*n;
Uint i;
@@ -612,9 +602,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 +616,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;
@@ -1341,7 +1337,7 @@ static BpData *is_break(BeamInstr *pc, BeamInstr break_op) {
return NULL;
}
- bd = ebd = rs[bp_sched2ix()];
+ bd = ebd = rs[erts_bp_sched2ix()];
ASSERT(bd);
if ( (break_op == 0) || (bd->this_instr == break_op)) {
return bd;
diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h
index 2ec5818688..167069552f 100644
--- a/erts/emulator/beam/beam_bp.h
+++ b/erts/emulator/beam/beam_bp.h
@@ -144,8 +144,6 @@ extern erts_smp_spinlock_t erts_bp_lock;
#define ErtsSmpBPUnlock(BDC)
#endif
-ERTS_INLINE Uint bp_sched2ix(void);
-
#ifdef ERTS_SMP
#define bp_sched2ix_proc(p) ((p)->scheduler_data->no - 1)
#else
@@ -247,4 +245,19 @@ BpData *erts_get_time_break(Process *p, BeamInstr *pc);
BeamInstr *erts_find_local_func(Eterm mfa[3]);
+ERTS_GLB_INLINE Uint erts_bp_sched2ix(void);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Uint erts_bp_sched2ix(void)
+{
+#ifdef ERTS_SMP
+ ErtsSchedulerData *esdp;
+ esdp = erts_get_scheduler_data();
+ return esdp->no - 1;
+#else
+ return 0;
+#endif
+}
+#endif
+
#endif /* _BEAM_BP_H */
diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c
index e795b4efbd..a550ec5ad0 100644
--- a/erts/emulator/beam/beam_catches.c
+++ b/erts/emulator/beam/beam_catches.c
@@ -22,21 +22,27 @@
#endif
#include "sys.h"
#include "beam_catches.h"
+#include "global.h"
-/* XXX: should use dynamic reallocation */
-#define TABSIZ (16*1024)
-static struct {
+/* R14B04 has about 380 catches when starting erlang */
+#define DEFAULT_TABSIZE (1024)
+typedef struct {
BeamInstr *cp;
unsigned cdr;
-} beam_catches[TABSIZ];
+} beam_catch_t;
static int free_list;
static unsigned high_mark;
+static unsigned tabsize;
+static beam_catch_t *beam_catches;
void beam_catches_init(void)
{
+ tabsize = DEFAULT_TABSIZE;
free_list = -1;
high_mark = 0;
+
+ beam_catches = erts_alloc(ERTS_ALC_T_CODE, sizeof(beam_catch_t)*DEFAULT_TABSIZE);
}
unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
@@ -50,16 +56,21 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
* This avoids the need to initialise the free list in
* beam_catches_init(), which would cost O(TABSIZ) time.
*/
- if( (i = free_list) >= 0 ) {
+ if( free_list >= 0 ) {
+ i = free_list;
free_list = beam_catches[i].cdr;
- } else if( (i = high_mark) < TABSIZ ) {
- high_mark = i + 1;
+ } else if( high_mark < tabsize ) {
+ i = high_mark;
+ high_mark++;
} else {
- fprintf(stderr, "beam_catches_cons: no free slots :-(\r\n");
- exit(1);
+ /* No free slots and table is full: realloc table */
+ tabsize = 2*tabsize;
+ beam_catches = erts_realloc(ERTS_ALC_T_CODE, beam_catches, sizeof(beam_catch_t)*tabsize);
+ i = high_mark;
+ high_mark++;
}
- beam_catches[i].cp = cp;
+ beam_catches[i].cp = cp;
beam_catches[i].cdr = cdr;
return i;
@@ -67,10 +78,8 @@ unsigned beam_catches_cons(BeamInstr *cp, unsigned cdr)
BeamInstr *beam_catches_car(unsigned i)
{
- if( i >= TABSIZ ) {
- fprintf(stderr,
- "beam_catches_car: index %#x is out of range\r\n", i);
- abort();
+ if( i >= tabsize ) {
+ erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
return beam_catches[i].cp;
}
@@ -80,18 +89,15 @@ void beam_catches_delmod(unsigned head, BeamInstr *code, unsigned code_bytes)
unsigned i, cdr;
for(i = head; i != (unsigned)-1;) {
- if( i >= TABSIZ ) {
- fprintf(stderr,
- "beam_catches_delmod: index %#x is out of range\r\n", i);
- abort();
+ if( i >= tabsize ) {
+ erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
if( (char*)beam_catches[i].cp - (char*)code >= code_bytes ) {
- fprintf(stderr,
+ erl_exit(1,
"beam_catches_delmod: item %#x has cp %#lx which is not "
"in module's range [%#lx,%#lx[\r\n",
i, (long)beam_catches[i].cp,
(long)code, (long)((char*)code + code_bytes));
- abort();
}
beam_catches[i].cp = 0;
cdr = beam_catches[i].cdr;
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 2b4448f93b..8041c92162 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -50,15 +50,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)) {
@@ -69,9 +72,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;
@@ -176,9 +183,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 73c9fdc5d7..c65b2be106 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -45,7 +45,7 @@
/* #define HARDDEBUG 1 */
#if defined(NO_JUMP_TABLE)
-# define OpCase(OpCode) case op_##OpCode: lb_##OpCode
+# define OpCase(OpCode) case op_##OpCode
# define CountCase(OpCode) case op_count_##OpCode
# define OpCode(OpCode) ((Uint*)op_##OpCode)
# define Goto(Rel) {Go = (int)(Rel); goto emulator_loop;}
@@ -53,7 +53,7 @@
#else
# define OpCase(OpCode) lb_##OpCode
# define CountCase(OpCode) lb_count_##OpCode
-# define Goto(Rel) goto *(Rel)
+# define Goto(Rel) goto *((void *)Rel)
# define LabelAddr(Label) &&Label
# define OpCode(OpCode) (&&lb_##OpCode)
#endif
@@ -199,7 +199,7 @@ do { \
} \
} while (0)
-#define ClauseFail() goto lb_jump_f
+#define ClauseFail() goto jump_f
#define SAVE_CP(X) \
do { \
@@ -234,6 +234,12 @@ BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */
BeamInstr beam_exception_trace[1]; /* UGLY also OpCode(i_return_trace) */
BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
+
+/*
+ * We should warn only once for tuple funs.
+ */
+static erts_smp_atomic_t warned_for_tuple_funs;
+
/*
* All Beam instructions in numerical order.
*/
@@ -304,44 +310,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)))
@@ -795,11 +763,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) \
@@ -1053,6 +1021,7 @@ init_emulator(void)
#if defined(VXWORKS)
init_done = 0;
#endif
+ erts_smp_atomic_init_nob(&warned_for_tuple_funs, (erts_aint_t) 0);
process_main();
}
@@ -1095,7 +1064,7 @@ void process_main(void)
Process* c_p = NULL;
int reds_used;
#ifdef DEBUG
- Eterm pid;
+ ERTS_DECLARE_DUMMY(Eterm pid);
#endif
/*
@@ -1146,26 +1115,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.
@@ -1202,14 +1156,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;
@@ -1226,14 +1172,12 @@ void process_main(void)
c_p = schedule(c_p, reds_used);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
#ifdef DEBUG
- pid = c_p->id;
+ pid = c_p->id; /* Save for debugging purpouses */
#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
@@ -1567,9 +1511,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;
@@ -1577,10 +1529,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;
@@ -2235,16 +2186,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);
@@ -2263,17 +2214,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);
@@ -2282,7 +2233,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;
@@ -2406,14 +2357,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);
@@ -2431,13 +2383,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);
@@ -2457,77 +2410,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):
+ OpCase(call_bif_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):
- {
- 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;
@@ -2537,61 +2422,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();
}
@@ -2599,7 +2452,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;
}
@@ -2695,6 +2547,7 @@ void process_main(void)
lb_Cl_error: {
if (Arg(0) != 0) {
OpCase(jump_f): {
+ jump_f:
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
@@ -3268,7 +3121,7 @@ void process_main(void)
/* Fall through */
OpCase(error_action_code): {
- no_error_handler:
+ handle_error:
reg[0] = r(0);
SWAPOUT;
I = handle_error(c_p, NULL, reg, NULL);
@@ -3352,64 +3205,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;
@@ -3420,17 +3232,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;
}
@@ -3473,7 +3282,7 @@ void process_main(void)
OpCase(i_func_info_IaaI): {
c_p->freason = EXC_FUNCTION_CLAUSE;
c_p->current = I + 2;
- goto lb_error_action_code;
+ goto handle_error;
}
OpCase(try_case_end_s):
@@ -3993,8 +3802,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);
@@ -4013,8 +3821,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;
@@ -4889,92 +4697,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.
*/
@@ -5033,7 +4755,12 @@ void process_main(void)
OpCase(fclearerror):
OpCase(i_fcheckerror):
erl_exit(1, "fclearerror/i_fcheckerror without fpe signals (beam_emu)");
+# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT
+# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR
#else
+# define ERTS_NO_FPE_CHECK_INIT(p)
+# define ERTS_NO_FPE_ERROR(p, a, b)
+
OpCase(fclearerror): {
BeamInstr *next;
@@ -5049,10 +4776,6 @@ void process_main(void)
ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith);
NextPF(0, next);
}
-# undef ERTS_FP_CHECK_INIT
-# undef ERTS_FP_ERROR
-# define ERTS_FP_CHECK_INIT(p)
-# define ERTS_FP_ERROR(p, a, b)
#endif
@@ -5060,45 +4783,45 @@ void process_main(void)
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fsub_lll): {
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fmul_lll): {
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fdiv_lll): {
BeamInstr *next;
PreFetch(3, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1));
- ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(2)), goto fbadarith);
NextPF(3, next);
}
OpCase(i_fnegate_ll): {
BeamInstr *next;
PreFetch(2, next);
- ERTS_FP_CHECK_INIT(c_p);
+ ERTS_NO_FPE_CHECK_INIT(c_p);
fb(Arg(1)) = -fb(Arg(0));
- ERTS_FP_ERROR(c_p, fb(Arg(1)), goto fbadarith);
+ ERTS_NO_FPE_ERROR(c_p, fb(Arg(1)), goto fbadarith);
NextPF(2, next);
fbadarith:
@@ -5152,10 +4875,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;
@@ -5247,7 +4968,7 @@ void process_main(void)
if (I) {
Goto(*I);
}
- goto no_error_handler;
+ goto handle_error;
}
@@ -5269,8 +4990,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");
/*
@@ -5687,6 +5408,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
@@ -5753,7 +5493,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;
@@ -5773,13 +5513,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;
@@ -5794,24 +5534,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;
@@ -5820,7 +5567,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 */
@@ -5835,7 +5582,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++;
@@ -5903,9 +5650,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;
@@ -5924,64 +5676,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;
}
@@ -6451,6 +6195,26 @@ call_fun(Process* p, /* Current process. */
if (!is_atom(module) || !is_atom(function)) {
goto badfun;
}
+
+ /*
+ * If this is the first time a tuple fun is used,
+ * send a warning to the logger.
+ */
+ if (erts_smp_atomic_xchg_nob(&warned_for_tuple_funs,
+ (erts_aint_t) 1) == 0) {
+ erts_dsprintf_buf_t* dsbufp;
+
+ dsbufp = erts_create_logger_dsbuf();
+ erts_dsprintf(dsbufp, "Call to tuple fun {%T,%T}.\n\n"
+ "Tuple funs are deprecated and will be removed "
+ "in R16. Use \"fun M:F/A\" instead, for example "
+ "\"fun %T:%T/%d\".\n\n"
+ "(This warning will only be shown the first time "
+ "a tuple fun is called.)\n",
+ module, function, module, function, arity);
+ erts_send_warning_to_logger(p->group_leader, dsbufp);
+ }
+
if ((ep = erts_find_export_entry(module, function, arity)) == NULL) {
ep = erts_find_export_entry(erts_proc_get_error_handler(p),
am_undefined_function, 3);
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index fceb352cf3..d8434c098e 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 */
};
/*
@@ -204,6 +206,7 @@ typedef struct {
Eterm term; /* The tagged term (in the heap). */
Uint heap_size; /* (Exact) size on the heap. */
Uint offset; /* Offset from temporary location to final. */
+ ErlOffHeap off_heap; /* Start of linked list of ProcBins. */
Eterm* heap; /* Heap for term. */
} Literal;
@@ -231,10 +234,19 @@ 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.
*/
-typedef struct {
+typedef struct LoaderState {
/*
* The current logical file within the binary.
*/
@@ -242,6 +254,7 @@ typedef struct {
char* file_name; /* Name of file we are reading (usually chunk name). */
byte* file_p; /* Current pointer within file. */
unsigned file_left; /* Number of bytes left in file. */
+ ErlDrvBinary* bin; /* Binary holding BEAM file (or NULL) */
/*
* The following are used mainly for diagnostics.
@@ -276,7 +289,6 @@ typedef struct {
BeamInstr* code; /* Loaded code. */
int ci; /* Current index into loaded code. */
Label* labels;
- BeamInstr new_bs_put_strings; /* Linked list of i_new_bs_put_string instructions. */
StringPatch* string_patches; /* Linked list of position into string table to patch. */
BeamInstr catches; /* Linked list of catch_yf instructions. */
unsigned loaded_size; /* Final size of code when loaded. */
@@ -325,12 +337,41 @@ 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 {
- unsigned num_functions; /* Number of functions. */
- 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 { \
@@ -455,19 +496,20 @@ typedef struct {
} while (0)
-static int bin_load(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size);
-static void init_state(LoaderState* stp);
-static int insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module,
- BeamInstr* code, Uint size, BeamInstr catches);
+static void free_state(LoaderState* stp);
+static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm group_leader, Eterm module,
+ BeamInstr* code, Uint size);
+static int init_iff_file(LoaderState* stp, byte* code, Uint size);
static int scan_iff_file(LoaderState* stp, Uint* chunk_types,
Uint num_types, Uint num_mandatory);
+static int verify_chunks(LoaderState* stp);
static int load_atom_table(LoaderState* stp);
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 +548,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;
@@ -550,7 +594,7 @@ define_file(LoaderState* stp, char* name, int idx)
stp->file_left = stp->chunks[idx].size;
}
-int
+Eterm
erts_load_module(Process *c_p,
ErtsProcLocks c_p_locks,
Eterm group_leader, /* Group leader or NIL if none. */
@@ -559,29 +603,17 @@ erts_load_module(Process *c_p,
* On return, contains the actual module name.
*/
byte* code, /* Points to the code to load */
- int size) /* Size of code to load. */
+ Uint size) /* Size of code to load. */
{
- ErlDrvBinary* bin;
- int result;
+ LoaderState* stp = erts_alloc_loader_state();
+ Eterm retval;
- if (size >= 4 && code[0] == 'F' && code[1] == 'O' &&
- code[2] == 'R' && code[3] == '1') {
- /*
- * The BEAM module is not compressed.
- */
- result = bin_load(c_p, c_p_locks, group_leader, modp, code, size);
- } else {
- /*
- * The BEAM module is compressed (or possibly invalid/corrupted).
- */
- if ((bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)code, size)) == NULL) {
- return -1;
- }
- result = bin_load(c_p, c_p_locks, group_leader, modp,
- (byte*)bin->orig_bytes, bin->orig_size);
- driver_free_binary(bin);
+ retval = erts_prepare_loading(stp, c_p, group_leader, modp,
+ code, size);
+ if (retval != NIL) {
+ return retval;
}
- return result;
+ return erts_finish_loading(stp, c_p, c_p_locks, modp);
}
/* #define LOAD_MEMORY_HARD_DEBUG 1*/
@@ -596,31 +628,28 @@ extern void check_allocated_block(Uint type, void *blk);
#define CHKBLK(TYPE,BLK) /* nothing */
#endif
-static int
-bin_load(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size)
+Eterm
+erts_prepare_loading(LoaderState* stp, Process *c_p, Eterm group_leader,
+ Eterm* modp, byte* code, Uint unloaded_size)
{
- LoaderState state;
- int rval = -1;
-
- init_state(&state);
- state.module = *modp;
- state.group_leader = group_leader;
+ Eterm retval = am_badfile;
- /*
- * Scan the IFF file.
- */
+ stp->module = *modp;
+ stp->group_leader = group_leader;
#if defined(LOAD_MEMORY_HARD_DEBUG) && defined(DEBUG)
erts_fprintf(stderr,"Loading a module\n");
#endif
+ /*
+ * Scan the IFF file.
+ */
+
CHKALLOC();
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- state.file_name = "IFF header for Beam file";
- state.file_p = bytes;
- state.file_left = unloaded_size;
- if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (!init_iff_file(stp, code, unloaded_size) ||
+ !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !verify_chunks(stp)) {
goto load_error;
}
@@ -628,38 +657,38 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the header for the code chunk.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "code chunk header", CODE_CHUNK);
- if (!read_code_header(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "code chunk header", CODE_CHUNK);
+ if (!read_code_header(stp)) {
goto load_error;
}
/*
* Initialize code area.
*/
- state.code_buffer_size = erts_next_heap_size(2048 + state.num_functions, 0);
- state.code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
- sizeof(BeamInstr) * state.code_buffer_size);
+ stp->code_buffer_size = erts_next_heap_size(2048 + stp->num_functions, 0);
+ stp->code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
+ sizeof(BeamInstr) * stp->code_buffer_size);
- state.code[MI_NUM_FUNCTIONS] = state.num_functions;
- state.ci = MI_FUNCTIONS + state.num_functions + 1;
+ stp->code[MI_NUM_FUNCTIONS] = stp->num_functions;
+ stp->ci = MI_FUNCTIONS + stp->num_functions + 1;
- state.code[MI_ATTR_PTR] = 0;
- state.code[MI_ATTR_SIZE] = 0;
- state.code[MI_ATTR_SIZE_ON_HEAP] = 0;
- state.code[MI_COMPILE_PTR] = 0;
- state.code[MI_COMPILE_SIZE] = 0;
- state.code[MI_COMPILE_SIZE_ON_HEAP] = 0;
- state.code[MI_NUM_BREAKPOINTS] = 0;
+ stp->code[MI_ATTR_PTR] = 0;
+ stp->code[MI_ATTR_SIZE] = 0;
+ stp->code[MI_ATTR_SIZE_ON_HEAP] = 0;
+ stp->code[MI_COMPILE_PTR] = 0;
+ stp->code[MI_COMPILE_SIZE] = 0;
+ stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0;
+ stp->code[MI_NUM_BREAKPOINTS] = 0;
/*
* Read the atom table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "atom table", ATOM_CHUNK);
- if (!load_atom_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "atom table", ATOM_CHUNK);
+ if (!load_atom_table(stp)) {
goto load_error;
}
@@ -667,9 +696,9 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the import table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "import table", IMP_CHUNK);
- if (!load_import_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "import table", IMP_CHUNK);
+ if (!load_import_table(stp)) {
goto load_error;
}
@@ -677,10 +706,10 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the lambda (fun) table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- if (state.chunks[LAMBDA_CHUNK].size > 0) {
- define_file(&state, "lambda (fun) table", LAMBDA_CHUNK);
- if (!read_lambda_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (stp->chunks[LAMBDA_CHUNK].size > 0) {
+ define_file(stp, "lambda (fun) table", LAMBDA_CHUNK);
+ if (!read_lambda_table(stp)) {
goto load_error;
}
}
@@ -689,10 +718,22 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Read the literal table.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- if (state.chunks[LITERAL_CHUNK].size > 0) {
- define_file(&state, "literals table (constant pool)", LITERAL_CHUNK);
- if (!read_literal_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (stp->chunks[LITERAL_CHUNK].size > 0) {
+ define_file(stp, "literals table (constant pool)", LITERAL_CHUNK);
+ if (!read_literal_table(stp)) {
+ goto load_error;
+ }
+ }
+
+ /*
+ * Read the line table (if present).
+ */
+
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (stp->chunks[LINE_CHUNK].size > 0) {
+ define_file(stp, "line table", LINE_CHUNK);
+ if (!read_line_table(stp)) {
goto load_error;
}
}
@@ -701,15 +742,15 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* Load the code chunk.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- state.file_name = "code chunk";
- state.file_p = state.code_start;
- state.file_left = state.code_size;
- if (!load_code(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ stp->file_name = "code chunk";
+ stp->file_p = stp->code_start;
+ stp->file_left = stp->code_size;
+ if (!load_code(stp)) {
goto load_error;
}
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- if (!freeze_code(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ if (!freeze_code(stp)) {
goto load_error;
}
@@ -719,9 +760,49 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* loading the code, because it contains labels.)
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- define_file(&state, "export table", EXP_CHUNK);
- if (!read_export_table(&state)) {
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ define_file(stp, "export table", EXP_CHUNK);
+ if (!read_export_table(stp)) {
+ goto load_error;
+ }
+
+ /*
+ * Good so far.
+ */
+
+ retval = NIL;
+
+ load_error:
+ if (retval != NIL) {
+ free_state(stp);
+ }
+ return retval;
+}
+
+Eterm
+erts_finish_loading(LoaderState* stp, Process* c_p,
+ ErtsProcLocks c_p_locks, Eterm* modp)
+{
+ Eterm retval;
+
+ /*
+ * No other process may run since we will update the export
+ * table which is not protected by any locks.
+ */
+
+ ERTS_SMP_LC_ASSERT(erts_initialized == 0 ||
+ erts_smp_thr_progress_is_blocking());
+
+ /*
+ * Make current code for the module old and insert the new code
+ * as current. This will fail if there already exists old code
+ * for the module.
+ */
+
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module,
+ stp->code, stp->loaded_size);
+ if (retval != NIL) {
goto load_error;
}
@@ -730,88 +811,43 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks,
* exported and imported functions. This can't fail.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- rval = insert_new_code(c_p, c_p_locks, state.group_leader, state.module,
- state.code, state.loaded_size, state.catches);
- if (rval < 0) {
- goto load_error;
- }
- CHKBLK(ERTS_ALC_T_CODE,state.code);
- final_touch(&state);
+ erts_export_consolidate();
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
+ final_touch(stp);
/*
* Loading succeded.
*/
- CHKBLK(ERTS_ALC_T_CODE,state.code);
+ CHKBLK(ERTS_ALC_T_CODE,stp->code);
#if defined(LOAD_MEMORY_HARD_DEBUG) && defined(DEBUG)
erts_fprintf(stderr,"Loaded %T\n",*modp);
#if 0
- debug_dump_code(state.code,state.ci);
+ debug_dump_code(stp->code,stp->ci);
#endif
#endif
- rval = 0;
- state.code = NULL; /* Prevent code from being freed. */
- *modp = state.module;
+ stp->code = NULL; /* Prevent code from being freed. */
+ *modp = stp->module;
/*
* If there is an on_load function, signal an error to
* indicate that the on_load function must be run.
*/
- if (state.on_load) {
- rval = -5;
+ if (stp->on_load) {
+ retval = am_on_load;
}
load_error:
- if (state.code != 0) {
- erts_free(ERTS_ALC_T_CODE, state.code);
- }
- if (state.labels != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels);
- }
- if (state.atom != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom);
- }
- if (state.import != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.import);
- }
- if (state.export != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export);
- }
- if (state.lambdas != state.def_lambdas) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas);
- }
- if (state.literals != NULL) {
- int i;
- for (i = 0; i < state.num_literals; i++) {
- if (state.literals[i].heap != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals[i].heap);
- }
- }
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals);
- }
- while (state.literal_patches != NULL) {
- LiteralPatch* next = state.literal_patches->next;
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literal_patches);
- state.literal_patches = next;
- }
- while (state.string_patches != NULL) {
- StringPatch* next = state.string_patches->next;
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.string_patches);
- state.string_patches = next;
- }
- while (state.genop_blocks) {
- GenOpBlock* next = state.genop_blocks->next;
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.genop_blocks);
- state.genop_blocks = next;
- }
-
- return rval;
+ free_state(stp);
+ return retval;
}
-
-static void
-init_state(LoaderState* stp)
+LoaderState*
+erts_alloc_loader_state(void)
{
+ LoaderState* stp;
+
+ stp = erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(LoaderState));
+ stp->bin = NULL;
stp->function = THE_NON_VALUE; /* Function not known yet */
stp->arity = 0;
stp->specific_op = -1;
@@ -835,23 +871,98 @@ 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;
+ return stp;
}
-static int
+static void
+free_state(LoaderState* stp)
+{
+ if (stp->bin != 0) {
+ driver_free_binary(stp->bin);
+ }
+ if (stp->code != 0) {
+ erts_free(ERTS_ALC_T_CODE, stp->code);
+ }
+ if (stp->labels != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->labels);
+ }
+ if (stp->atom != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->atom);
+ }
+ if (stp->import != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->import);
+ }
+ if (stp->export != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->export);
+ }
+ if (stp->lambdas != stp->def_lambdas) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->lambdas);
+ }
+ if (stp->literals != NULL) {
+ int i;
+ for (i = 0; i < stp->num_literals; i++) {
+ if (stp->literals[i].heap != NULL) {
+ erts_free(ERTS_ALC_T_LOADER_TMP,
+ (void *) stp->literals[i].heap);
+ }
+ }
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->literals);
+ }
+ while (stp->literal_patches != NULL) {
+ LiteralPatch* next = stp->literal_patches->next;
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->literal_patches);
+ stp->literal_patches = next;
+ }
+ while (stp->string_patches != NULL) {
+ StringPatch* next = stp->string_patches->next;
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->string_patches);
+ stp->string_patches = next;
+ }
+ while (stp->genop_blocks) {
+ GenOpBlock* next = stp->genop_blocks->next;
+ erts_free(ERTS_ALC_T_LOADER_TMP, (void *) stp->genop_blocks);
+ stp->genop_blocks = next;
+ }
+
+ if (stp->line_item != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->line_item);
+ }
+
+ if (stp->line_instr != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->line_instr);
+ }
+
+ if (stp->func_line != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->func_line);
+ }
+
+ if (stp->fname != 0) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp->fname);
+ }
+
+ erts_free(ERTS_ALC_T_LOADER_TMP, stp);
+}
+
+static Eterm
insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module, BeamInstr* code, Uint size, BeamInstr catches)
+ Eterm group_leader, Eterm module, BeamInstr* code,
+ Uint size)
{
Module* modp;
- int rval;
+ Eterm retval;
int i;
- if ((rval = beam_make_current_old(c_p, c_p_locks, module)) < 0) {
+ if ((retval = beam_make_current_old(c_p, c_p_locks, module)) < 0) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp,
"Module %T must be purged before loading\n",
module);
erts_send_error_to_logger(group_leader, dsbufp);
- return rval;
+ return retval;
}
/*
@@ -862,7 +973,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
modp = erts_put_module(module);
modp->code = code;
modp->code_length = size;
- modp->catches = catches;
+ modp->catches = BEAM_CATCHES_NIL; /* Will be filled in later. */
/*
* Update address table (used for finding a function from a PC value).
@@ -884,27 +995,51 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
modules[i].end = (BeamInstr *) (((byte *)code) + size);
num_loaded_modules++;
mid_module = &modules[num_loaded_modules/2];
- return 0;
+ return NIL;
}
static int
-scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory)
+init_iff_file(LoaderState* stp, byte* code, Uint size)
{
- MD5_CTX context;
+ Uint form_id = MakeIffId('F', 'O', 'R', '1');
Uint id;
Uint count;
- int i;
+
+ if (size < 4) {
+ goto load_error;
+ }
/*
- * The binary must start with an IFF 'FOR1' chunk.
+ * Check if the module is compressed (or possibly invalid/corrupted).
*/
+ if (MakeIffId(code[0], code[1], code[2], code[3]) != form_id) {
+ stp->bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)code, size);
+ if (stp->bin == NULL) {
+ goto load_error;
+ }
+ code = (byte*)stp->bin->orig_bytes;
+ size = stp->bin->orig_size;
+ if (size < 4) {
+ goto load_error;
+ }
+ }
- GetInt(stp, 4, id);
- if (id != MakeIffId('F', 'O', 'R', '1')) {
+ /*
+ * The binary must start with an IFF 'FOR1' chunk.
+ */
+ if (MakeIffId(code[0], code[1], code[2], code[3]) != form_id) {
LoadError0(stp, "not a BEAM file: no IFF 'FOR1' chunk");
}
/*
+ * Initialize our "virtual file system".
+ */
+
+ stp->file_name = "IFF header for Beam file";
+ stp->file_p = code + 4;
+ stp->file_left = size - 4;
+
+ /*
* Retrieve the chunk size and verify it. If the size is equal to
* or less than the size of the binary, it is ok and we will use it
* as the limit for the logical file size.
@@ -925,6 +1060,21 @@ scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mand
if (id != MakeIffId('B', 'E', 'A', 'M')) {
LoadError0(stp, "not a BEAM file: IFF form type is not 'BEAM'");
}
+ return 1;
+
+ load_error:
+ return 0;
+}
+
+/*
+ * Scan the IFF file. The header should have been verified by init_iff_file().
+ */
+static int
+scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory)
+{
+ Uint count;
+ Uint id;
+ int i;
/*
* Initialize the chunks[] array in the state.
@@ -981,17 +1131,25 @@ scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mand
stp->file_p += count;
stp->file_left -= count;
}
+ return 1;
- /*
- * At this point, we have read the entire IFF file, and we
- * know that it is syntactically correct.
- *
- * Now check that it contains all mandatory chunks. At the
- * same time calculate the MD5 for the module.
- */
+ load_error:
+ return 0;
+}
+
+/*
+ * Verify that all mandatory chunks are present and calculate
+ * MD5 for the module.
+ */
+
+static int
+verify_chunks(LoaderState* stp)
+{
+ int i;
+ MD5_CTX context;
MD5Init(&context);
- for (i = 0; i < num_mandatory; i++) {
+ for (i = 0; i < NUM_MANDATORY; i++) {
if (stp->chunks[i].start != NULL) {
MD5Update(&context, stp->chunks[i].start, stp->chunks[i].size);
} else {
@@ -1001,41 +1159,49 @@ scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mand
LoadError1(stp, "mandatory chunk of type '%s' not found\n", sbuf);
}
}
- if (LITERAL_CHUNK < num_types) {
- if (stp->chunks[LAMBDA_CHUNK].start != 0) {
- byte* start = stp->chunks[LAMBDA_CHUNK].start;
- Uint left = stp->chunks[LAMBDA_CHUNK].size;
- /*
- * The idea here is to ignore the OldUniq field for the fun; it is
- * based on the old broken hash function, which can be different
- * on little endian and big endian machines.
- */
- if (left >= 4) {
- static byte zero[4];
- MD5Update(&context, start, 4);
- start += 4;
- left -= 4;
+ /*
+ * If there is a lambda chunk, include parts of it in the MD5.
+ */
+ if (stp->chunks[LAMBDA_CHUNK].start != 0) {
+ byte* start = stp->chunks[LAMBDA_CHUNK].start;
+ Uint left = stp->chunks[LAMBDA_CHUNK].size;
+
+ /*
+ * The idea here is to ignore the OldUniq field for the fun; it is
+ * based on the old broken hash function, which can be different
+ * on little endian and big endian machines.
+ */
+ if (left >= 4) {
+ static byte zero[4];
+ MD5Update(&context, start, 4);
+ start += 4;
+ left -= 4;
- while (left >= 24) {
- /* Include: Function Arity Index NumFree */
- MD5Update(&context, start, 20);
- /* Set to zero: OldUniq */
- MD5Update(&context, zero, 4);
- start += 24;
- left -= 24;
- }
- }
- /* Can't happen for a correct 'FunT' chunk */
- if (left > 0) {
- MD5Update(&context, start, left);
+ while (left >= 24) {
+ /* Include: Function Arity Index NumFree */
+ MD5Update(&context, start, 20);
+ /* Set to zero: OldUniq */
+ MD5Update(&context, zero, 4);
+ start += 24;
+ left -= 24;
}
}
- if (stp->chunks[LITERAL_CHUNK].start != 0) {
- MD5Update(&context, stp->chunks[LITERAL_CHUNK].start,
- stp->chunks[LITERAL_CHUNK].size);
+ /* Can't happen for a correct 'FunT' chunk */
+ if (left > 0) {
+ MD5Update(&context, start, left);
}
}
+
+
+ /*
+ * If there is a literal chunk, include it in the MD5.
+ */
+ if (stp->chunks[LITERAL_CHUNK].start != 0) {
+ MD5Update(&context, stp->chunks[LITERAL_CHUNK].start,
+ stp->chunks[LITERAL_CHUNK].size);
+ }
+
MD5Final(stp->mod_md5, &context);
return 1;
@@ -1297,12 +1463,14 @@ read_literal_table(LoaderState* stp)
GetInt(stp, 4, sz); /* Size of external term format. */
GetString(stp, p, sz);
- if ((heap_size = erts_decode_ext_size(p, sz, 1)) < 0) {
+ if ((heap_size = erts_decode_ext_size(p, sz)) < 0) {
LoadError1(stp, "literal %d: bad external format", i);
}
hp = stp->literals[i].heap = erts_alloc(ERTS_ALC_T_LOADER_TMP,
heap_size*sizeof(Eterm));
- val = erts_decode_ext(&hp, NULL, &p);
+ stp->literals[i].off_heap.first = 0;
+ stp->literals[i].off_heap.overhead = 0;
+ val = erts_decode_ext(&hp, &stp->literals[i].off_heap, &p);
stp->literals[i].heap_size = hp - stp->literals[i].heap;
if (stp->literals[i].heap_size > heap_size) {
erl_exit(1, "overrun by %d word(s) for literal heap, term %d",
@@ -1324,6 +1492,138 @@ read_literal_table(LoaderState* stp)
return 0;
}
+static int
+read_line_table(LoaderState* stp)
+{
+ unsigned version;
+ ERTS_DECLARE_DUMMY(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 +1658,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);
}
@@ -1382,7 +1687,6 @@ read_code_header(LoaderState* stp)
#endif
}
- stp->new_bs_put_strings = 0;
stp->catches = 0;
return 1;
@@ -1415,7 +1719,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 +1732,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 +1979,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 +2029,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 +2338,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 +2345,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;
@@ -2065,32 +2398,6 @@ load_code(LoaderState* stp)
stp->on_load = ci;
break;
case op_bs_put_string_II:
- {
- /*
- * At entry:
- *
- * code[ci-3] &&lb_i_new_bs_put_string_II
- * code[ci-2] length of string
- * code[ci-1] offset into string table
- *
- * Since we don't know the address of the string table yet,
- * just check the offset and length for validity, and use
- * the instruction field as a link field to link all put_string
- * instructions into a single linked list. At exit:
- *
- * code[ci-3] pointer to next i_new_bs_put_string instruction (or 0
- * if this is the last)
- */
- Uint offset = code[ci-1];
- Uint len = code[ci-2];
- unsigned strtab_size = stp->chunks[STR_CHUNK].size;
- if (offset > strtab_size || offset + len > strtab_size) {
- LoadError2(stp, "invalid string reference %d, size %d", offset, len);
- }
- code[ci-3] = stp->new_bs_put_strings;
- stp->new_bs_put_strings = ci - 3;
- }
- break;
case op_i_bs_match_string_rfII:
case op_i_bs_match_string_xfII:
new_string_patch(stp, ci-1);
@@ -2105,6 +2412,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 +2487,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 +3744,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 +3765,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 +3800,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 +3843,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;
@@ -3561,15 +3934,14 @@ freeze_code(LoaderState* stp)
{
BeamInstr* code = stp->code;
Uint *literal_end = NULL;
- Uint index;
int i;
byte* str_table;
unsigned strtab_size = stp->chunks[STR_CHUNK].size;
unsigned attr_size = stp->chunks[ATTR_CHUNK].size;
unsigned compile_size = stp->chunks[COMPILE_CHUNK].size;
Uint size;
- unsigned catches;
Sint decoded_size;
+ Uint line_size;
/*
* Verify that there was a correct 'FunT' chunk if there were
@@ -3580,13 +3952,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.
@@ -3623,6 +4001,8 @@ freeze_code(LoaderState* stp)
Uint* low;
Uint* high;
LiteralPatch* lp;
+ struct erl_off_heap_header* off_heap = 0;
+ struct erl_off_heap_header** off_heap_last = &off_heap;
low = (Uint *) (code+stp->ci);
high = low + stp->total_literal_size;
@@ -3631,6 +4011,7 @@ freeze_code(LoaderState* stp)
ptr = low;
for (i = 0; i < stp->num_literals; i++) {
Uint offset;
+ struct erl_off_heap_header* t_off_heap;
sys_memcpy(ptr, stp->literals[i].heap,
stp->literals[i].heap_size*sizeof(Eterm));
@@ -3645,9 +4026,19 @@ freeze_code(LoaderState* stp)
*ptr++ = offset_ptr(val, offset);
break;
case TAG_PRIMARY_HEADER:
- ptr++;
- if (header_is_thing(val)) {
- ptr += thing_arityval(val);
+ if (header_is_transparent(val)) {
+ ptr++;
+ } else {
+ if (thing_subtag(val) == REFC_BINARY_SUBTAG) {
+ struct erl_off_heap_header* oh;
+
+ oh = (struct erl_off_heap_header*) ptr;
+ if (oh->next) {
+ Eterm** uptr = (Eterm **) (void *) &oh->next;
+ *uptr += offset;
+ }
+ }
+ ptr += 1 + thing_arityval(val);
}
break;
default:
@@ -3656,7 +4047,23 @@ freeze_code(LoaderState* stp)
}
}
ASSERT(ptr == high);
+
+ /*
+ * Re-link the off_heap list for this term onto the
+ * off_heap list for the entire module.
+ */
+ t_off_heap = stp->literals[i].off_heap.first;
+ if (t_off_heap) {
+ t_off_heap = (struct erl_off_heap_header *)
+ offset_ptr((UWord) t_off_heap, offset);
+ while (t_off_heap) {
+ *off_heap_last = t_off_heap;
+ off_heap_last = &t_off_heap->next;
+ t_off_heap = t_off_heap->next;
+ }
+ }
}
+ code[MI_LITERALS_OFF_HEAP] = (BeamInstr) off_heap;
lp = stp->literal_patches;
while (lp != 0) {
BeamInstr* op_ptr;
@@ -3674,21 +4081,72 @@ 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);
code[MI_ATTR_PTR] = (BeamInstr) attr;
code[MI_ATTR_SIZE] = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
- decoded_size = erts_decode_ext_size(attr, attr_size, 0);
+ decoded_size = erts_decode_ext_size(attr, attr_size);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of module attributes");
}
@@ -3706,7 +4164,7 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
CHKBLK(ERTS_ALC_T_CODE,code);
- decoded_size = erts_decode_ext_size(compile_info, compile_size, 0);
+ decoded_size = erts_decode_ext_size(compile_info, compile_size);
CHKBLK(ERTS_ALC_T_CODE,code);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of compilation information");
@@ -3723,20 +4181,8 @@ freeze_code(LoaderState* stp)
((byte *) code) + size);
/*
- * Go through all i_new_bs_put_strings instructions, restore the pointer to
- * the instruction and convert string offsets to pointers (to the
- * FIRST character).
+ * Patch all instructions that refer to the string table.
*/
-
- index = stp->new_bs_put_strings;
- while (index != 0) {
- Uint next = code[index];
- code[index] = BeamOpCode(op_bs_put_string_II);
- code[index+2] = (BeamInstr) (str_table + code[index+2]);
- index = next;
- }
- CHKBLK(ERTS_ALC_T_CODE,code);
-
{
StringPatch* sp = stp->string_patches;
@@ -3777,21 +4223,6 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
/*
- * Fix all catch_yf instructions.
- */
- index = stp->catches;
- catches = BEAM_CATCHES_NIL;
- while (index != 0) {
- BeamInstr next = code[index];
- code[index] = BeamOpCode(op_catch_yf);
- catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
- code[index+2] = make_catch(catches);
- index = next;
- }
- stp->catches = catches;
- CHKBLK(ERTS_ALC_T_CODE,code);
-
- /*
* Save the updated code pointer and code size.
*/
@@ -3816,6 +4247,26 @@ final_touch(LoaderState* stp)
{
int i;
int on_load = stp->on_load;
+ unsigned catches;
+ Uint index;
+ BeamInstr* code = stp->code;
+ Module* modp;
+
+ /*
+ * Allocate catch indices and fix up all catch_yf instructions.
+ */
+
+ index = stp->catches;
+ catches = BEAM_CATCHES_NIL;
+ while (index != 0) {
+ BeamInstr next = code[index];
+ code[index] = BeamOpCode(op_catch_yf);
+ catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
+ code[index+2] = make_catch(catches);
+ index = next;
+ }
+ modp = erts_put_module(stp->module);
+ modp->catches = catches;
/*
* Export functions.
@@ -3899,6 +4350,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 +4364,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 +4376,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 +4565,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 +4582,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 +4620,7 @@ transform_engine(LoaderState* st)
*lastp = st->genop;
st->genop = new_instr;
}
- break;
+ RETURN(TE_OK);
#endif
case TOP_new_instr:
/*
@@ -4180,12 +4629,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 +4642,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);
}
@@ -4532,6 +4983,8 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size)
lit->heap_size = heap_size;
lit->heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, heap_size*sizeof(Eterm));
lit->term = make_boxed(lit->heap);
+ lit->off_heap.first = 0;
+ lit->off_heap.overhead = 0;
*hpp = lit->heap;
return stp->num_literals++;
}
@@ -4810,17 +5263,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,26 +5297,160 @@ 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)
{
- LoaderState state;
+ Process* p = BIF_P;
+ Eterm Bin = BIF_ARG_1;
+ Eterm Chunk = BIF_ARG_2;
+ LoaderState* stp;
Uint chunk = 0;
ErlSubBin* sb;
Uint offset;
@@ -4868,15 +5462,16 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
Eterm real_bin;
byte* temp_alloc = NULL;
+ stp = erts_alloc_loader_state();
if ((start = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) {
error:
erts_free_aligned_binary_bytes(temp_alloc);
+ if (stp) {
+ free_state(stp);
+ }
BIF_ERROR(p, BADARG);
}
- state.module = THE_NON_VALUE; /* Suppress diagnostiscs */
- state.file_name = "IFF header for Beam file";
- state.file_p = start;
- state.file_left = binary_size(Bin);
+ stp->module = THE_NON_VALUE; /* Suppress diagnostics */
for (i = 0; i < 4; i++) {
Eterm* chunkp;
Eterm num;
@@ -4894,25 +5489,30 @@ code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk)
if (is_not_nil(Chunk)) {
goto error;
}
- if (!scan_iff_file(&state, &chunk, 1, 1)) {
- erts_free_aligned_binary_bytes(temp_alloc);
- return am_undefined;
+ if (!init_iff_file(stp, start, binary_size(Bin)) ||
+ !scan_iff_file(stp, &chunk, 1, 1) ||
+ stp->chunks[0].start == NULL) {
+ res = am_undefined;
+ goto done;
}
ERTS_GET_REAL_BIN(Bin, real_bin, offset, bitoffs, bitsize);
if (bitoffs) {
- res = new_binary(p, state.chunks[0].start, state.chunks[0].size);
+ res = new_binary(p, stp->chunks[0].start, stp->chunks[0].size);
} else {
sb = (ErlSubBin *) HAlloc(p, ERL_SUB_BIN_SIZE);
sb->thing_word = HEADER_SUB_BIN;
sb->orig = real_bin;
- sb->size = state.chunks[0].size;
+ sb->size = stp->chunks[0].size;
sb->bitsize = 0;
sb->bitoffs = 0;
- sb->offs = offset + (state.chunks[0].start - start);
+ sb->offs = offset + (stp->chunks[0].start - start);
sb->is_writable = 0;
res = make_binary(sb);
}
+
+ done:
erts_free_aligned_binary_bytes(temp_alloc);
+ free_state(stp);
return res;
}
@@ -4920,24 +5520,34 @@ 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)
{
- LoaderState state;
+ Process* p = BIF_P;
+ Eterm Bin = BIF_ARG_1;
+ LoaderState* stp;
+ byte* bytes;
byte* temp_alloc = NULL;
+ Eterm res;
- if ((state.file_p = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) {
+ stp = erts_alloc_loader_state();
+ if ((bytes = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) {
+ free_state(stp);
BIF_ERROR(p, BADARG);
}
- state.module = THE_NON_VALUE; /* Suppress diagnostiscs */
- state.file_name = "IFF header for Beam file";
- state.file_left = binary_size(Bin);
-
- if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) {
- return am_undefined;
+ stp->module = THE_NON_VALUE; /* Suppress diagnostiscs */
+ if (!init_iff_file(stp, bytes, binary_size(Bin)) ||
+ !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !verify_chunks(stp)) {
+ res = am_undefined;
+ goto done;
}
+ res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5));
+
+ done:
erts_free_aligned_binary_bytes(temp_alloc);
- return new_binary(p, state.mod_md5, sizeof(state.mod_md5));
+ free_state(stp);
+ return res;
}
#define WORDS_PER_FUNCTION 6
@@ -4972,7 +5582,7 @@ stub_copy_info(LoaderState* stp,
if (size != 0) {
memcpy(info, stp->chunks[chunk].start, size);
*ptr_word = (BeamInstr) info;
- decoded_size = erts_decode_ext_size(info, size, 0);
+ decoded_size = erts_decode_ext_size(info, size);
if (decoded_size < 0) {
return 0;
}
@@ -5179,7 +5789,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;
@@ -5200,7 +5820,7 @@ patch_funentries(Eterm Patchlist)
Eterm
erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
{
- LoaderState state;
+ LoaderState* stp;
BeamInstr Funcs;
BeamInstr Patchlist;
Eterm* tp;
@@ -5213,16 +5833,15 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
int code_size;
int rval;
int i;
- ErlDrvBinary* bin = NULL;
byte* temp_alloc = NULL;
byte* bytes;
Uint size;
/*
- * Must initialize state.lambdas here because the error handling code
+ * Must initialize stp->lambdas here because the error handling code
* at label 'error' uses it.
*/
- init_state(&state);
+ stp = erts_alloc_loader_state();
if (is_not_atom(Mod)) {
goto error;
@@ -5246,47 +5865,35 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
size = binary_size(Beam);
/*
- * Uncompressed if needed.
- */
- if (!(size >= 4 && bytes[0] == 'F' && bytes[1] == 'O' &&
- bytes[2] == 'R' && bytes[3] == '1')) {
- bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)bytes, size);
- if (bin == NULL) {
- goto error;
- }
- bytes = (byte*)bin->orig_bytes;
- size = bin->orig_size;
- }
-
- /*
* Scan the Beam binary and read the interesting sections.
*/
- state.file_name = "IFF header for Beam file";
- state.file_p = bytes;
- state.file_left = size;
- state.module = Mod;
- state.group_leader = p->group_leader;
- state.num_functions = n;
- if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) {
+ stp->module = Mod;
+ stp->group_leader = p->group_leader;
+ stp->num_functions = n;
+ if (!init_iff_file(stp, bytes, size)) {
+ goto error;
+ }
+ if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY) ||
+ !verify_chunks(stp)) {
goto error;
}
- define_file(&state, "code chunk header", CODE_CHUNK);
- if (!read_code_header(&state)) {
+ define_file(stp, "code chunk header", CODE_CHUNK);
+ if (!read_code_header(stp)) {
goto error;
}
- define_file(&state, "atom table", ATOM_CHUNK);
- if (!load_atom_table(&state)) {
+ define_file(stp, "atom table", ATOM_CHUNK);
+ if (!load_atom_table(stp)) {
goto error;
}
- define_file(&state, "export table", EXP_CHUNK);
- if (!stub_read_export_table(&state)) {
+ define_file(stp, "export table", EXP_CHUNK);
+ if (!stub_read_export_table(stp)) {
goto error;
}
- if (state.chunks[LAMBDA_CHUNK].size > 0) {
- define_file(&state, "lambda (fun) table", LAMBDA_CHUNK);
- if (!read_lambda_table(&state)) {
+ if (stp->chunks[LAMBDA_CHUNK].size > 0) {
+ define_file(stp, "lambda (fun) table", LAMBDA_CHUNK);
+ if (!read_lambda_table(stp)) {
goto error;
}
}
@@ -5296,8 +5903,8 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
*/
code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr);
- code_size += state.chunks[ATTR_CHUNK].size;
- code_size += state.chunks[COMPILE_CHUNK].size;
+ code_size += stp->chunks[ATTR_CHUNK].size;
+ code_size += stp->chunks[COMPILE_CHUNK].size;
code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
if (!code) {
goto error;
@@ -5315,6 +5922,9 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
code[MI_COMPILE_SIZE] = 0;
code[MI_COMPILE_SIZE_ON_HEAP] = 0;
code[MI_NUM_BREAKPOINTS] = 0;
+ code[MI_LITERALS_START] = 0;
+ code[MI_LITERALS_END] = 0;
+ code[MI_LITERALS_OFF_HEAP] = 0;
code[MI_ON_LOAD_FUNCTION_PTR] = 0;
ci = MI_FUNCTIONS + n + 1;
@@ -5387,12 +5997,12 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
*/
info = (byte *) fp;
- info = stub_copy_info(&state, ATTR_CHUNK, info,
+ info = stub_copy_info(stp, ATTR_CHUNK, info,
code+MI_ATTR_PTR, code+MI_ATTR_SIZE_ON_HEAP);
if (info == NULL) {
goto error;
}
- info = stub_copy_info(&state, COMPILE_CHUNK, info,
+ info = stub_copy_info(stp, COMPILE_CHUNK, info,
code+MI_COMPILE_PTR, code+MI_COMPILE_SIZE_ON_HEAP);
if (info == NULL) {
goto error;
@@ -5402,9 +6012,8 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Insert the module in the module table.
*/
- rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size,
- BEAM_CATCHES_NIL);
- if (rval < 0) {
+ rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size);
+ if (rval != NIL) {
goto error;
}
@@ -5414,46 +6023,19 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
fp = code + ci;
for (i = 0; i < n; i++) {
- stub_final_touch(&state, fp);
+ stub_final_touch(stp, fp);
fp += WORDS_PER_FUNCTION;
}
if (patch_funentries(Patchlist)) {
erts_free_aligned_binary_bytes(temp_alloc);
- if (state.lambdas != state.def_lambdas) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas);
- }
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels);
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom);
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export);
- if (bin != NULL) {
- driver_free_binary(bin);
- }
+ free_state(stp);
return Mod;
}
error:
erts_free_aligned_binary_bytes(temp_alloc);
- if (code != NULL) {
- erts_free(ERTS_ALC_T_CODE, code);
- }
- if (state.labels != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels);
- }
- if (state.lambdas != state.def_lambdas) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas);
- }
- if (state.atom != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom);
- }
- if (state.export != NULL) {
- erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export);
- }
- if (bin != NULL) {
- driver_free_binary(bin);
- }
-
-
+ free_state(stp);
BIF_ERROR(p, BADARG);
}
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index 26e3054c4b..4e22ee4d79 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -23,7 +23,9 @@
#include "beam_opcodes.h"
#include "erl_process.h"
-int beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module);
+Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm module);
+
typedef struct gen_op_entry {
char* name;
@@ -101,11 +103,18 @@ extern Uint erts_total_code_size;
*/
#define MI_LITERALS_START 8
#define MI_LITERALS_END 9
+#define MI_LITERALS_OFF_HEAP 10
+
/*
* Pointer to the on_load function (or NULL if none).
*/
-#define MI_ON_LOAD_FUNCTION_PTR 10
+#define MI_ON_LOAD_FUNCTION_PTR 11
+
+/*
+ * Pointer to the line table (or NULL if none).
+ */
+#define MI_LINE_TABLE 12
/*
* Start of function pointer table. This table contains pointers to
@@ -116,5 +125,5 @@ extern Uint erts_total_code_size;
* this table.
*/
-#define MI_FUNCTIONS 11
+#define MI_FUNCTIONS 13
#endif /* _BEAM_LOAD_H */
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 07fdd809f8..f5616af95e 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -1106,9 +1106,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);
}
@@ -1118,10 +1118,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);
}
/**********************************************************************/
@@ -1130,12 +1130,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);
}
/**********************************************************************/
@@ -1145,10 +1145,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);
}
/**********************************************************************/
@@ -1158,12 +1158,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);
}
/**********************************************************************/
@@ -1182,14 +1182,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;
@@ -1205,35 +1210,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;
@@ -1241,13 +1285,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;
}
@@ -1255,7 +1315,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:
@@ -1671,10 +1731,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);
}
@@ -2011,8 +2071,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;
@@ -2076,8 +2141,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) {
@@ -3253,8 +3323,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;
@@ -3503,9 +3576,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;
@@ -3521,8 +3595,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);
@@ -3586,8 +3659,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);
}
@@ -3652,9 +3730,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));
@@ -3992,7 +4072,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,
@@ -4232,8 +4312,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);
}
}
@@ -4241,8 +4320,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);
}
}
@@ -4257,7 +4335,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;
@@ -4269,7 +4346,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..46db9ca99c 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -310,12 +310,12 @@
#define DREM(a1,a0,b,r) do { \
ErtsDigit __a1 = (a1); \
ErtsDigit __b = (b); \
- ErtsDigit __q0; \
+ ERTS_DECLARE_DUMMY(ErtsDigit __q0); \
DDIVREM((__a1 % __b), (a0), __b, __q0, r); \
} while(0)
#define DDIV(a1,a0,b,q) do { \
- ErtsDigit _tmp; \
+ ERTS_DECLARE_DUMMY(ErtsDigit _tmp); \
DDIVREM(a1,a0,b,q,_tmp); \
} while(0)
@@ -413,8 +413,8 @@
} while(0)
#define DDIV2(a1,a0,b1,b0,q) do { \
- ErtsDigit _tmp_r1; \
- ErtsDigit _tmp_r0; \
+ ERTS_DECLARE_DUMMY(ErtsDigit _tmp_r1); \
+ ERTS_DECLARE_DUMMY(ErtsDigit _tmp_r0); \
D2DIVREM(a1,a0,b1,b0,q,_tmp_r1,_tmp_r0); \
} while(0)
@@ -810,7 +810,9 @@ static dsize_t D_div(ErtsDigit* x, dsize_t xl, ErtsDigit d, ErtsDigit* q, ErtsDi
}
do {
- ErtsDigit q0, a0, b1, b0, b;
+ ErtsDigit q0, a0, b0;
+ ERTS_DECLARE_DUMMY(ErtsDigit b);
+ ERTS_DECLARE_DUMMY(ErtsDigit b1);
if (d > a1) {
a0 = *xp;
@@ -1584,6 +1586,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 8d37ae9f9b..784e55ecd2 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -95,7 +95,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/copy.c b/erts/emulator/beam/copy.c
index 90201f3a90..1d968fb147 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -134,7 +134,7 @@ Uint size_object(Eterm obj)
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
- Uint offset; /* Not used. */
+ ERTS_DECLARE_DUMMY(Uint offset); /* Not used. */
Uint bitsize;
Uint bitoffs;
Uint extra_bytes;
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index d62eed21b4..44c5ba1e26 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -968,7 +968,7 @@ int erts_net_message(Port *prt,
res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache);
if (res >= 0)
- res = ctl_len = erts_decode_dist_ext_size(&ede, 0);
+ res = ctl_len = erts_decode_dist_ext_size(&ede);
else {
#ifdef ERTS_DIST_MSG_DBG
erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n");
@@ -2731,85 +2731,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_alloc.c b/erts/emulator/beam/erl_alloc.c
index 33d6cf5f2f..140a84d5fc 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -2758,16 +2758,18 @@ erts_allocator_options(void *proc)
void *erts_alloc_permanent_cache_aligned(ErtsAlcType_t type, Uint size)
{
- UWord v = (UWord) erts_alloc(type, size + (ERTS_CACHE_LINE_SIZE-1));
+ UWord v = (UWord) erts_alloc(type, size + (ERTS_CACHE_LINE_SIZE-1)
+#ifdef VALGRIND
+ + sizeof(UWord)
+#endif
+ );
#ifdef VALGRIND
- { /* Avoid Leak_PossiblyLost */
- static UWord vg_root_set[10];
- static unsigned ix = 0;
- if (ix >= sizeof(vg_root_set) / sizeof(*vg_root_set)) {
- erl_exit(ERTS_ABORT_EXIT, "Too many erts_alloc_permanent_cache_aligned's\n");
- }
- vg_root_set[ix++] = v; /* not thread safe */
+ { /* Link them to avoid Leak_PossiblyLost */
+ static UWord* first_in_list = NULL;
+ *(UWord**)v = first_in_list;
+ first_in_list = (UWord*) v;
+ v += sizeof(UWord);
}
#endif
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..7e7bec9b87 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)
{
@@ -1148,7 +1152,7 @@ static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend,
erts_free_aligned_binary_bytes(temp_alloc);
return DO_BIN_MATCH_RESTART;
} else {
- Eterm epos = erts_make_integer(pos+hsstart,p);
+ Eterm epos = erts_make_integer(pos,p);
Eterm erlen = erts_make_integer(rlen,p);
hp = HAlloc(p,3);
ret = TUPLE2(hp, epos, erlen);
@@ -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));
}
@@ -1882,9 +1898,9 @@ static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction)
cd = (CommonData *) ERTS_MAGIC_BIN_DATA(mb);
l = list;
while (is_list(l)) {
- Uint bitoffs;
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
Uint bitsize;
- Uint offset;
+ ERTS_DECLARE_DUMMY(Uint offset);
Eterm real_bin;
ProcBin* pb;
@@ -2361,7 +2377,7 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
{
Uint n;
byte *bytes;
- Uint bit_offs;
+ ERTS_DECLARE_DUMMY(Uint bit_offs);
Uint bit_size;
size_t size;
Uint reds = get_reds(p, BINARY_COPY_LOOP_FACTOR);
@@ -2390,9 +2406,9 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
if ((target_size - size) >= reds) {
Eterm orig;
- Uint offset;
- Uint bit_offset;
- Uint bit_size;
+ ERTS_DECLARE_DUMMY(Uint offset);
+ ERTS_DECLARE_DUMMY(Uint bit_offset);
+ ERTS_DECLARE_DUMMY(Uint bit_size);
CopyBinState *cbs;
Eterm *hp;
Eterm trap_term;
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index d714eacd06..b2d5722e9b 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;
@@ -1558,14 +1569,14 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
if ((res = erts_sys_ddll_load_driver_init(dh->handle,
&init_handle)) != ERL_DE_NO_ERROR) {
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_NO_INIT;
+ res = ERL_DE_LOAD_ERROR_NO_INIT;
+ goto error;
}
dp = erts_sys_ddll_call_init(init_handle);
if (dp == NULL) {
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_FAILED_INIT;
+ res = ERL_DE_LOAD_ERROR_FAILED_INIT;
+ goto error;
}
switch (dp->extended_marker) {
@@ -1583,24 +1594,27 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
|| dp->handle2 != NULL
|| dp->process_exit != NULL) {
/* Old driver; needs to be recompiled... */
- return ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ goto error;
}
break;
case ERL_DRV_EXTENDED_MARKER:
if (ERL_DRV_EXTENDED_MAJOR_VERSION != dp->major_version
|| ERL_DRV_EXTENDED_MINOR_VERSION < dp->minor_version) {
/* Incompatible driver version */
- return ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ goto error;
}
break;
default:
/* Old driver; needs to be recompiled... */
- return ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ res = ERL_DE_LOAD_ERROR_INCORRECT_VERSION;
+ goto error;
}
if (strcmp(name, dp->driver_name) != 0) {
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_BAD_NAME;
+ res = ERL_DE_LOAD_ERROR_BAD_NAME;
+ goto error;
}
erts_smp_atomic_init_nob(&(dh->refc), (erts_aint_t) 0);
dh->port_count = 0;
@@ -1615,11 +1629,14 @@ static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
*/
erts_free(ERTS_ALC_T_DDLL_HANDLE, dh->full_path);
dh->full_path = NULL;
- erts_sys_ddll_close(dh->handle);
- return ERL_DE_LOAD_ERROR_FAILED_INIT;
+ res = ERL_DE_LOAD_ERROR_FAILED_INIT;
+ goto error;
}
-
return ERL_DE_NO_ERROR;
+
+error:
+ erts_sys_ddll_close(dh->handle);
+ return res;
}
static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name)
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index c50537078b..db04fe5a54 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -123,6 +123,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)
{
@@ -558,6 +568,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
@@ -606,8 +618,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;
}
@@ -1010,35 +1024,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:
@@ -1612,6 +1606,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)
{
@@ -2028,7 +2129,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)) {
@@ -2155,16 +2256,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));
@@ -2190,16 +2282,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);
@@ -2647,9 +2730,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,
@@ -2672,7 +2757,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;
}
@@ -2681,7 +2766,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.
@@ -2717,24 +2802,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) {
@@ -2742,7 +2830,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) {
@@ -2754,10 +2842,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;
}
@@ -2773,11 +2861,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);
@@ -2789,25 +2877,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) {
@@ -2817,7 +2905,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;
}
}
@@ -2829,7 +2917,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);
@@ -2846,18 +2934,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
@@ -2876,7 +2964,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;
}
@@ -2890,9 +2978,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;
@@ -4042,6 +4133,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)
{
@@ -4051,4 +4163,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..6b8f1b21fd 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;
@@ -378,18 +385,18 @@ BIF_RETTYPE port_call_3(BIF_ALIST_3)
/* Error or a binary without magic/ with wrong magic */
goto error;
}
- result_size = erts_decode_ext_size(port_resp, ret, 0);
+ result_size = erts_decode_ext_size(port_resp, ret);
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 3e942dcc55..b0a58c80ea 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -48,6 +48,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);
@@ -77,13 +82,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;
@@ -436,9 +447,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;
@@ -821,9 +835,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);
@@ -1753,23 +1769,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)) {
@@ -1779,35 +1792,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
@@ -1920,23 +1938,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;
@@ -2054,11 +2084,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 259ebd838e..38b4a2d460 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
*/
@@ -1295,8 +1298,13 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
UWord heir_data;
Uint32 status;
Sint keypos;
- int is_named, is_fine_locked, frequent_read, is_compressed;
+ int is_named, is_compressed;
+#ifdef ERTS_SMP
+ int is_fine_locked, frequent_read;
+#endif
+#ifdef DEBUG
int cret;
+#endif
DeclareTmpHeap(meta_tuple,3,BIF_P);
DbTableMethod* meth;
erts_smp_rwmtx_t *mmtl;
@@ -1311,8 +1319,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
status = DB_NORMAL | DB_SET | DB_PROTECTED;
keypos = 1;
is_named = 0;
+#ifdef ERTS_SMP
is_fine_locked = 0;
frequent_read = 0;
+#endif
heir = am_none;
heir_data = (UWord) am_undefined;
is_compressed = erts_ets_always_compress;
@@ -1341,18 +1351,31 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
keypos = signed_val(tp[2]);
}
else if (tp[1] == am_write_concurrency) {
+#ifdef ERTS_SMP
if (tp[2] == am_true) {
is_fine_locked = 1;
} else if (tp[2] == am_false) {
is_fine_locked = 0;
} else break;
+#else
+ if ((tp[2] != am_true) && (tp[2] != am_false)) {
+ break;
+ }
+#endif
}
else if (tp[1] == am_read_concurrency) {
+#ifdef ERTS_SMP
if (tp[2] == am_true) {
frequent_read = 1;
} else if (tp[2] == am_false) {
frequent_read = 0;
} else break;
+#else
+ if ((tp[2] != am_true) && (tp[2] != am_false)) {
+ break;
+ }
+#endif
+
}
else if (tp[1] == am_heir && tp[2] == am_none) {
heir = am_none;
@@ -1392,11 +1415,11 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
}
if (IS_HASH_TABLE(status)) {
meth = &db_hash;
- #ifdef ERTS_SMP
+#ifdef ERTS_SMP
if (is_fine_locked && !(status & DB_PRIVATE)) {
status |= DB_FINE_LOCKED;
}
- #endif
+#endif
}
else if (IS_TREE_TABLE(status)) {
meth = &db_tree;
@@ -1444,7 +1467,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);
@@ -1941,8 +1967,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;
@@ -2108,7 +2136,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)
@@ -2124,7 +2152,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;
}
@@ -2142,7 +2170,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;
}
@@ -2150,6 +2178,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;
@@ -2160,22 +2194,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);
@@ -2187,22 +2221,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;
@@ -2247,6 +2283,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;
@@ -2260,28 +2301,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);
@@ -2293,20 +2333,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;
@@ -2319,19 +2365,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);
@@ -2343,21 +2389,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;
@@ -2498,7 +2546,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)
@@ -2552,7 +2600,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)
@@ -2568,7 +2616,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;
}
@@ -2586,7 +2634,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;
}
@@ -2605,7 +2653,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)) {
@@ -2614,7 +2664,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) {
@@ -3520,8 +3572,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_hash.c b/erts/emulator/beam/erl_db_hash.c
index e3380a57b2..038a667b06 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -312,15 +312,24 @@ struct ext_segment {
struct segment* segtab[1]; /* The segment table */
};
#define SIZEOF_EXTSEG(NSEGS) \
- (sizeof(struct ext_segment) - sizeof(struct segment*) + sizeof(struct segment*)*(NSEGS))
+ (offsetof(struct ext_segment,segtab) + sizeof(struct segment*)*(NSEGS))
-#ifdef DEBUG
-# include <stddef.h> /* offsetof */
+#if defined(DEBUG) || defined(VALGRIND)
# define EXTSEG(SEGTAB_PTR) \
((struct ext_segment*) (((char*)(SEGTAB_PTR)) - offsetof(struct ext_segment,segtab)))
#endif
+static ERTS_INLINE void SET_SEGTAB(DbTableHash* tb,
+ struct segment** segtab)
+{
+ erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) segtab);
+#ifdef VALGRIND
+ tb->top_ptr_to_segment_with_active_segtab = EXTSEG(segtab);
+#endif
+}
+
+
/* How the table segments relate to each other:
ext_segment: ext_segment: "plain" segment
@@ -649,7 +658,8 @@ int db_create_hash(Process *p, DbTable *tbl)
erts_smp_atomic_init_nob(&tb->szm, SEGSZ_MASK);
erts_smp_atomic_init_nob(&tb->nactive, SEGSZ);
erts_smp_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL);
- erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t) alloc_ext_seg(tb,0,NULL)->segtab);
+ erts_smp_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL);
+ SET_SEGTAB(tb, alloc_ext_seg(tb,0,NULL)->segtab);
tb->nsegs = NSEG_1;
tb->nslots = SEGSZ;
@@ -2357,7 +2367,7 @@ static int alloc_seg(DbTableHash *tb)
struct ext_segment* eseg;
eseg = (struct ext_segment*) SEGTAB(tb)[seg_ix-1];
MY_ASSERT(eseg!=NULL && eseg->s.is_ext_segment);
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t) eseg->segtab);
+ SET_SEGTAB(tb, eseg->segtab);
tb->nsegs = eseg->nsegs;
}
ASSERT(seg_ix < tb->nsegs);
@@ -2429,7 +2439,7 @@ static int free_seg(DbTableHash *tb, int free_records)
MY_ASSERT(newtop->s.is_ext_segment);
if (newtop->prev_segtab != NULL) {
/* Time to use a smaller segtab */
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t)newtop->prev_segtab);
+ SET_SEGTAB(tb, newtop->prev_segtab);
tb->nsegs = seg_ix;
ASSERT(tb->nsegs == EXTSEG(SEGTAB(tb))->nsegs);
}
@@ -2446,7 +2456,7 @@ static int free_seg(DbTableHash *tb, int free_records)
if (seg_ix > 0) {
if (seg_ix < tb->nsegs) SEGTAB(tb)[seg_ix] = NULL;
} else {
- erts_smp_atomic_set_wb(&tb->segtab, (erts_aint_t)NULL);
+ SET_SEGTAB(tb, NULL);
}
#endif
tb->nslots -= SEGSZ;
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index e0285fa5ed..23ac493118 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -58,6 +58,9 @@ typedef struct db_table_hash {
#ifdef ERTS_SMP
DbTableHashFineLocks* locks;
#endif
+#ifdef VALGRIND
+ struct ext_segment* top_ptr_to_segment_with_active_segtab;
+#endif
} DbTableHash;
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 68b7b7aa6a..4821a7d9fb 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -496,7 +496,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
@@ -909,14 +909,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;
@@ -924,20 +928,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));
}
/*
@@ -1705,6 +1716,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
@@ -1958,7 +1970,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;
@@ -1969,7 +1981,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;
@@ -1980,7 +1992,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;
@@ -1992,7 +2006,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;
@@ -2847,7 +2864,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) {
@@ -2869,7 +2888,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 */
@@ -4971,7 +4993,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 8faaf9f367..eb2b945877 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);
}
@@ -590,7 +595,9 @@ erts_garbage_collect_hibernate(Process* p)
void
-erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
+erts_garbage_collect_literals(Process* p, Eterm* literals,
+ Uint lit_size,
+ struct erl_off_heap_header* oh)
{
Uint byte_lit_size = sizeof(Eterm)*lit_size;
Uint old_heap_size;
@@ -602,6 +609,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
Uint area_size;
Eterm* old_htop;
Uint n;
+ struct erl_off_heap_header** prev;
/*
* Set GC state.
@@ -635,6 +643,9 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
offset_heap(temp_lit, lit_size, offs, (char *) literals, byte_lit_size);
offset_heap(p->heap, p->htop - p->heap, offs, (char *) literals, byte_lit_size);
offset_rootset(p, offs, (char *) literals, byte_lit_size, p->arg_reg, p->arity);
+ if (oh) {
+ oh = (struct erl_off_heap_header *) ((Eterm *)(void *) oh + offs);
+ }
/*
* Now the literals are placed in memory that is safe to write into,
@@ -702,6 +713,45 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
p->old_htop = old_htop;
/*
+ * Prepare to sweep binaries. Since all MSOs on the new heap
+ * must be come before MSOs on the old heap, find the end of
+ * current MSO list and use that as a starting point.
+ */
+
+ if (oh) {
+ prev = &MSO(p).first;
+ while (*prev) {
+ prev = &(*prev)->next;
+ }
+ }
+
+ /*
+ * Sweep through all binaries in the temporary literal area.
+ */
+
+ while (oh) {
+ if (IS_MOVED_BOXED(oh->thing_word)) {
+ Binary* bptr;
+ struct erl_off_heap_header* ptr;
+
+ ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
+ ASSERT(thing_subtag(ptr->thing_word) == REFC_BINARY_SUBTAG);
+ bptr = ((ProcBin*)ptr)->val;
+
+ /*
+ * This binary has been copied to the heap.
+ * We must increment its reference count and
+ * link it into the MSO list for the process.
+ */
+
+ erts_refc_inc(&bptr->refc, 1);
+ *prev = ptr;
+ prev = &ptr->next;
+ }
+ oh = oh->next;
+ }
+
+ /*
* We no longer need this temporary area.
*/
erts_free(ERTS_ALC_T_TMP, (void *) temp_lit);
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index fa4bab07b8..717315d8bd 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -92,7 +92,6 @@ int erts_use_sender_punish;
*/
Uint display_items; /* no of items to display in traces etc */
-Uint display_loads; /* print info about loaded modules */
int H_MIN_SIZE; /* The minimum heap grain */
int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/
@@ -129,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.
*/
@@ -433,7 +434,7 @@ static void
load_preloaded(void)
{
int i;
- int res;
+ Eterm res;
Preload* preload_p;
Eterm module_name;
byte* code;
@@ -452,8 +453,9 @@ load_preloaded(void)
name);
res = erts_load_module(NULL, 0, NIL, &module_name, code, length);
sys_preload_end(&preload_p[i]);
- if (res < 0)
- erl_exit(1,"Failed loading preloaded module %s\n", name);
+ if (res != NIL)
+ erl_exit(1,"Failed loading preloaded module %s (%T)\n",
+ name, res);
i++;
}
}
@@ -495,8 +497,6 @@ void erts_usage(void)
erts_fprintf(stderr, "-K boolean enable or disable kernel poll\n");
- erts_fprintf(stderr, "-l turn on auto load tracing\n");
-
erts_fprintf(stderr, "-M<X> <Y> memory allocator switches,\n");
erts_fprintf(stderr, " see the erts_alloc(3) documentation for more info.\n");
@@ -511,6 +511,8 @@ void erts_usage(void)
erts_fprintf(stderr, "-rg amount set reader groups limit\n");
erts_fprintf(stderr, "-sbt type set scheduler bind type, valid types are:\n");
erts_fprintf(stderr, " u|ns|ts|ps|s|nnts|nnps|tnnps|db\n");
+ erts_fprintf(stderr, "-scl bool enable/disable compaction of scheduler load,\n");
+ erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
erts_fprintf(stderr, "-sct cput set cpu topology,\n");
erts_fprintf(stderr, " see the erl(1) documentation for more info.\n");
erts_fprintf(stderr, "-swt val set scheduler wakeup threshold, valid values are:\n");
@@ -608,10 +610,10 @@ early_init(int *argc, char **argv) /*
char envbuf[21]; /* enough for any 64-bit integer */
size_t envbufsz;
+ erts_sched_compact_load = 1;
erts_printf_eterm_func = erts_printf_term;
erts_disable_tolerant_timeofday = 0;
display_items = 200;
- display_loads = 0;
erts_backtrace_depth = DEFAULT_BACKTRACE_SIZE;
erts_async_max_threads = 0;
erts_async_thread_suggested_stack_size = ERTS_ASYNC_THREAD_MIN_STACK_SIZE;
@@ -976,10 +978,9 @@ erl_start(int argc, char **argv)
erts_fprintf(stderr, "%s unknown flag %s\n", argv[0], argv[i]);
erts_usage();
}
- case 'l':
- display_loads++;
+ case 'L':
+ erts_no_line_info = 1;
break;
-
case 'v':
#ifdef DEBUG
if (argv[i][2] == '\0') {
@@ -1197,6 +1198,19 @@ erl_start(int argc, char **argv)
erts_usage();
}
}
+ else if (has_prefix("cl", sub_param)) {
+ arg = get_arg(sub_param+2, argv[i+1], &i);
+ if (sys_strcmp("true", arg) == 0)
+ erts_sched_compact_load = 1;
+ else if (sys_strcmp("false", arg) == 0)
+ erts_sched_compact_load = 0;
+ else {
+ erts_fprintf(stderr,
+ "bad scheduler compact load value '%s'\n",
+ arg);
+ erts_usage();
+ }
+ }
else if (has_prefix("ct", sub_param)) {
arg = get_arg(sub_param+2, argv[i+1], &i);
res = erts_init_cpu_topology_string(arg);
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 82f272d28a..16be47d540 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -240,7 +240,7 @@ erts_msg_distext2heap(Process *pp,
Sint sz;
*bpp = NULL;
- sz = erts_decode_dist_ext_size(dist_extp, 0);
+ sz = erts_decode_dist_ext_size(dist_extp);
if (sz < 0)
goto decode_error;
if (is_not_nil(*tokenp)) {
@@ -713,7 +713,7 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
ASSERT(msg->data.dist_ext);
ASSERT(msg->data.dist_ext->heap_size < 0);
- sz = erts_decode_dist_ext_size(msg->data.dist_ext, 0);
+ sz = erts_decode_dist_ext_size(msg->data.dist_ext);
if (sz < 0) {
/* Bad external; remove it */
if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
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 818156fce6..740a1b853e 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -131,10 +131,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[];*/
};
@@ -245,7 +248,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;
@@ -290,6 +293,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)
@@ -436,24 +440,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;
@@ -467,12 +483,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);
@@ -487,8 +504,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;
@@ -677,6 +696,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));
@@ -684,6 +704,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;
@@ -1022,6 +1043,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); }
@@ -1625,7 +1669,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
}
else { /* Function traced, patch the original instruction word */
BpData** bps = (BpData**) code_ptr[1];
- BpData* bp = (BpData*) bps[bp_sched2ix()];
+ BpData* bp = (BpData*) bps[erts_bp_sched2ix()];
bp->orig_instr = (BeamInstr) BeamOp(op_call_nif);
}
code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr;
@@ -1716,8 +1760,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;
@@ -1734,7 +1780,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 04926fe283..ec4b1dcd98 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -114,6 +114,7 @@ static Sint p_serial;
static Uint p_serial_mask;
static Uint p_serial_shift;
+int erts_sched_compact_load;
Uint erts_no_schedulers;
Uint erts_max_processes = ERTS_DEFAULT_MAX_PROCESSES;
Uint erts_process_tab_index_mask;
@@ -222,10 +223,6 @@ typedef union {
static ErtsAlignedSchedulerSleepInfo *aligned_sched_sleep_info;
-#ifndef BM_COUNTERS
-static int processes_busy;
-#endif
-
Process** process_tab;
static Uint last_reductions;
static Uint last_exact_reductions;
@@ -494,9 +491,6 @@ erts_init_process(int ncpu)
p_serial_shift = erts_fit_in_bits(erts_max_processes - 1);
p_serial_mask = ((~(~((Uint) 0) << proc_bits)) >> p_serial_shift);
erts_process_tab_index_mask = ~(~((Uint) 0) << p_serial_shift);
-#ifndef BM_COUNTERS
- processes_busy = 0;
-#endif
last_reductions = 0;
last_exact_reductions = 0;
erts_default_process_flags = 0;
@@ -2885,6 +2879,9 @@ check_balance(ErtsRunQueue *c_rq)
mmax_len = run_queue_info[qix].max_len;
}
+ if (!erts_sched_compact_load)
+ goto all_active;
+
if (!forced && half_full_scheds != blnc_no_rqs) {
int min = 1;
if (min < half_full_scheds)
@@ -3407,11 +3404,14 @@ erts_init_scheduling(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
@@ -6741,7 +6741,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
goto error;
}
+#ifdef BM_COUNTERS
processes_busy++;
+#endif
BM_COUNT(processes_spawned);
#ifndef HYBRID
@@ -6989,7 +6991,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->pending_exit.bp = NULL;
#endif
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
p->fp_exception = 0;
#endif
@@ -7163,7 +7165,7 @@ void erts_init_empty_process(Process *p)
p->run_queue = ERTS_RUNQ_IX(0);
#endif
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
p->fp_exception = 0;
#endif
@@ -8264,7 +8266,9 @@ continue_exit_process(Process *p
pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL);
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
+#ifdef BM_COUNTERS
processes_busy--;
+#endif
if (dep) {
erts_do_net_exits(dep, reason);
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 67c0b72130..a51b380bb0 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -95,6 +95,7 @@ struct saved_calls {
};
extern Export exp_send, exp_receive, exp_timeout;
+extern int erts_sched_compact_load;
extern Uint erts_no_schedulers;
extern Uint erts_no_run_queues;
extern int erts_sched_thread_suggested_stack_size;
@@ -421,19 +422,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() */
@@ -604,7 +601,7 @@ struct process {
Uint min_heap_size; /* Minimum size of heap (in words). */
Uint min_vheap_size; /* Minimum size of virtual heap (in words). */
-#if !defined(NO_FPE_SIGNALS)
+#if !defined(NO_FPE_SIGNALS) || defined(HIPE)
volatile unsigned long fp_exception;
#endif
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index da97523dd0..a5a753b798 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 ec99f76e53..b487dbf054 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -2094,8 +2094,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);
@@ -2109,10 +2108,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);
@@ -2124,8 +2123,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.
@@ -2157,7 +2154,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..6d5eae73b0 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,
@@ -227,8 +227,8 @@ static ERTS_INLINE int simple_loops_to_common(int cost)
static Sint aligned_binary_size(Eterm binary)
{
- unsigned char *bytes;
- Uint bitoffs;
+ ERTS_DECLARE_DUMMY(unsigned char *bytes);
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
Uint bitsize;
ERTS_GET_BINARY_BYTES(binary, bytes, bitoffs, bitsize);
@@ -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;
}
@@ -901,7 +894,9 @@ static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos,
static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
{
+#ifdef DEBUG
Eterm *real_bin;
+#endif
byte* bytes;
Eterm rest_term;
int left, sleft;
@@ -915,8 +910,10 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
/*erts_printf("Trap %T!\r\n",BIF_ARG_2);*/
ASSERT(is_binary(BIF_ARG_1));
+#ifdef DEBUG
real_bin = binary_val(BIF_ARG_1);
ASSERT(*real_bin == HEADER_PROC_BIN);
+#endif
pos = (int) binary_size(BIF_ARG_1);
bytes = binary_bytes(BIF_ARG_1);
sleft = left = allowed_iterations(BIF_P);
@@ -1230,10 +1227,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) {
@@ -1730,7 +1723,7 @@ static BIF_RETTYPE do_bif_utf8_to_list(Process *p,
if (b_sz) {
ErlSubBin *sb;
Eterm orig;
- Uint offset;
+ ERTS_DECLARE_DUMMY(Uint offset);
ASSERT(state != ERTS_UTF8_OK);
hp = HAlloc(p, ERL_SUB_BIN_SIZE);
sb = (ErlSubBin *) hp;
@@ -1839,13 +1832,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 +2159,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 +2306,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) |
@@ -2580,11 +2570,11 @@ BIF_RETTYPE prim_file_internal_native2name_1(BIF_ALIST_1)
BIF_RETTYPE prim_file_internal_normalize_utf8_1(BIF_ALIST_1)
{
- Eterm real_bin;
- Uint offset;
+ ERTS_DECLARE_DUMMY(Eterm real_bin);
+ ERTS_DECLARE_DUMMY(Uint offset);
Uint size,num_chars;
Uint bitsize;
- Uint bitoffs;
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
Eterm ret;
byte *temp_alloc = NULL;
byte *bytes;
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 0b07e894cf..5dc307e383 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..4b867f2b10 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -88,7 +88,7 @@ static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*);
static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*);
static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*);
-static Sint decoded_size(byte *ep, byte* endp, int only_heap_bins, int internal_tags);
+static Sint decoded_size(byte *ep, byte* endp, int internal_tags);
static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned);
@@ -810,7 +810,7 @@ bad_dist_ext(ErtsDistExternal *edep)
}
Sint
-erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins)
+erts_decode_dist_ext_size(ErtsDistExternal *edep)
{
Sint res;
byte *ep;
@@ -829,7 +829,7 @@ erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins)
goto fail;
ep = edep->extp+1;
}
- res = decoded_size(ep, edep->ext_endp, no_refc_bins, 0);
+ res = decoded_size(ep, edep->ext_endp, 0);
if (res >= 0)
return res;
fail:
@@ -837,16 +837,16 @@ erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins)
return -1;
}
-Sint erts_decode_ext_size(byte *ext, Uint size, int no_refc_bins)
+Sint erts_decode_ext_size(byte *ext, Uint size)
{
if (size == 0 || *ext != VERSION_MAGIC)
return -1;
- return decoded_size(ext+1, ext+size, no_refc_bins, 0);
+ return decoded_size(ext+1, ext+size, 0);
}
Sint erts_decode_ext_size_ets(byte *ext, Uint size)
{
- Sint sz = decoded_size(ext, ext+size, 0, 1);
+ Sint sz = decoded_size(ext, ext+size, 1);
ASSERT(sz >= 0);
return sz;
}
@@ -968,7 +968,7 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
ede.extp = binary_bytes(real_bin)+offset;
ede.ext_endp = ede.extp + size;
- hsz = erts_decode_dist_ext_size(&ede, 0);
+ hsz = erts_decode_dist_ext_size(&ede);
if (hsz < 0)
goto badarg;
@@ -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;
@@ -1106,7 +1106,7 @@ binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size)
goto error;
size = (Sint) dest_len;
}
- res = decoded_size(state->extp, state->extp + size, 0, 0);
+ res = decoded_size(state->extp, state->extp + size, 0);
if (res < 0)
goto error;
return res;
@@ -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));
}
}
@@ -2451,7 +2454,7 @@ dec_term_atom_common:
n = get_int32(ep);
ep += 4;
- if (n <= ERL_ONHEAP_BIN_LIMIT || off_heap == NULL) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
ErlHeapBin* hb = (ErlHeapBin *) hp;
hb->thing_word = header_heap_bin(n);
@@ -2489,7 +2492,7 @@ dec_term_atom_common:
n = get_int32(ep);
bitsize = ep[4];
ep += 5;
- if (n <= ERL_ONHEAP_BIN_LIMIT || off_heap == NULL) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
ErlHeapBin* hb = (ErlHeapBin *) hp;
hb->thing_word = header_heap_bin(n);
@@ -3058,7 +3061,7 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
}
static Sint
-decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags)
+decoded_size(byte *ep, byte* endp, int internal_tags)
{
int heap_size = 0;
int terms;
@@ -3220,7 +3223,7 @@ decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags)
CHKSIZE(4);
n = get_int32(ep);
SKIP2(n, 4);
- if (n <= ERL_ONHEAP_BIN_LIMIT || no_refc_bins) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
heap_size += heap_bin_size(n);
} else {
heap_size += PROC_BIN_SIZE;
@@ -3231,7 +3234,7 @@ decoded_size(byte *ep, byte* endp, int no_refc_bins, int internal_tags)
CHKSIZE(5);
n = get_int32(ep);
SKIP2(n, 5);
- if (n <= ERL_ONHEAP_BIN_LIMIT || no_refc_bins) {
+ if (n <= ERL_ONHEAP_BIN_LIMIT) {
heap_size += heap_bin_size(n) + ERL_SUB_BIN_SIZE;
} else {
heap_size += PROC_BIN_SIZE + ERL_SUB_BIN_SIZE;
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index 671b8b8781..eddd4571dd 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -175,10 +175,10 @@ void *erts_dist_ext_trailer(ErtsDistExternal *);
void erts_destroy_dist_ext_copy(ErtsDistExternal *);
int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint,
DistEntry *, ErtsAtomCache *);
-Sint erts_decode_dist_ext_size(ErtsDistExternal *, int);
+Sint erts_decode_dist_ext_size(ErtsDistExternal *);
Eterm erts_decode_dist_ext(Eterm **, ErlOffHeap *, ErtsDistExternal *);
-Sint erts_decode_ext_size(byte*, Uint, int);
+Sint erts_decode_ext_size(byte*, Uint);
Sint erts_decode_ext_size_ets(byte*, Uint);
Eterm erts_decode_ext(Eterm **, ErlOffHeap *, byte**);
Eterm erts_decode_ext_ets(Eterm **, ErlOffHeap *, byte*);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index b40bab9b33..d5b74efd98 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"
@@ -554,7 +555,6 @@ extern Eterm node_cookie;
extern erts_smp_atomic_t erts_bytes_out; /* no bytes written out */
extern erts_smp_atomic_t erts_bytes_in; /* no bytes sent into the system */
extern Uint display_items; /* no of items to display in traces etc */
-extern Uint display_loads; /* print info about loaded modules */
extern int erts_backtrace_depth;
extern erts_smp_atomic32_t erts_max_gen_gcs;
@@ -845,18 +845,41 @@ 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 */
-int erts_load_module(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm* mod, byte* code, int size);
+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;
+
+struct LoaderState* erts_alloc_loader_state(void);
+Eterm erts_prepare_loading(struct LoaderState*, Process *c_p,
+ Eterm group_leader, Eterm* modp,
+ byte* code, Uint size);
+Eterm erts_finish_loading(struct LoaderState* stp, Process* c_p,
+ ErtsProcLocks c_p_locks, Eterm* modp);
+Eterm erts_load_module(Process *c_p, ErtsProcLocks c_p_locks,
+ Eterm group_leader, Eterm* mod, byte* code, Uint 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);
@@ -1047,6 +1070,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 */
@@ -1068,6 +1092,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;
@@ -1101,7 +1126,9 @@ void erts_init_gc(void);
int erts_garbage_collect(Process*, int, Eterm*, int);
void erts_garbage_collect_hibernate(Process* p);
Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity);
-void erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size);
+void erts_garbage_collect_literals(Process* p, Eterm* literals,
+ Uint lit_size,
+ struct erl_off_heap_header* oh);
Uint erts_next_heap_size(Uint, Uint);
Eterm erts_heap_sizes(Process* p);
@@ -1621,8 +1648,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/io.c b/erts/emulator/beam/io.c
index fff720634d..132dc78515 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -952,7 +952,7 @@ io_list_to_vec(Eterm obj, /* io-list */
do { \
int _size = binary_size(obj); \
Eterm _real; \
- Uint _offset; \
+ ERTS_DECLARE_DUMMY(Uint _offset); \
int _bitoffs; \
int _bitsize; \
ERTS_GET_REAL_BIN(obj, _real, _offset, _bitoffs, _bitsize); \
@@ -2171,8 +2171,8 @@ erts_port_control(Process* p, Port* prt, Uint command, Eterm iolist)
* and with its length in to_len.
*/
if (is_binary(iolist) && binary_bitoffset(iolist) == 0) {
- Uint bitoffs;
- Uint bitsize;
+ ERTS_DECLARE_DUMMY(Uint bitoffs);
+ ERTS_DECLARE_DUMMY(Uint bitsize);
ERTS_GET_BINARY_BYTES(iolist, to_port, bitoffs, bitsize);
to_len = binary_size(iolist);
} else {
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/sys.h b/erts/emulator/beam/sys.h
index f9cbcc5892..94c36c8c59 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -103,6 +103,15 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
# define ERTS_LIKELY(BOOL) (BOOL)
# define ERTS_UNLIKELY(BOOL) (BOOL)
#endif
+#ifdef __GNUC__
+# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5)
+# define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused))
+# else
+# define ERTS_DECLARE_DUMMY(X) X
+# endif
+#else
+# define ERTS_DECLARE_DUMMY(X) X
+#endif
#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
# undef ERTS_CAN_INLINE
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index aa86f4590d..df03f5e42c 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -45,6 +45,7 @@
#include "erl_thr_progress.h"
#include "erl_thr_queue.h"
#include "erl_sched_spec_pre_alloc.h"
+#include "beam_bp.h"
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
@@ -2647,7 +2648,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[CMP_TMP_HEAP_SIZE]; /* If HEAP_ON_C_STACK */
#else
Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap;
#endif
@@ -2658,41 +2659,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:
@@ -2888,14 +2956,14 @@ Eterm
buf_to_intlist(Eterm** hpp, char *buf, int len, Eterm tail)
{
Eterm* hp = *hpp;
+ int i = len - 1;
- buf += (len-1);
- while(len > 0) {
- tail = CONS(hp, make_small((byte)*buf), tail);
+ while(i >= 0) {
+ tail = CONS(hp, make_small((Uint)(byte)buf[i]), tail);
hp += 2;
- buf--;
- len--;
+ --i;
}
+
*hpp = hp;
return tail;
}