aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator')
-rw-r--r--erts/emulator/Makefile.in4
-rw-r--r--erts/emulator/beam/atom.names5
-rw-r--r--erts/emulator/beam/beam_bp.c2
-rw-r--r--erts/emulator/beam/beam_emu.c22
-rw-r--r--erts/emulator/beam/big.c2
-rw-r--r--erts/emulator/beam/break.c2
-rw-r--r--erts/emulator/beam/erl_alloc.c6
-rw-r--r--erts/emulator/beam/erl_alloc.h2
-rw-r--r--erts/emulator/beam/erl_alloc.types2
-rw-r--r--erts/emulator/beam/erl_alloc_util.c41
-rw-r--r--erts/emulator/beam/erl_alloc_util.h2
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.h2
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.h2
-rw-r--r--erts/emulator/beam/erl_bif_trace.c23
-rw-r--r--erts/emulator/beam/erl_gc.c17
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.h2
-rw-r--r--erts/emulator/beam/erl_init.c17
-rw-r--r--erts/emulator/beam/erl_lock_check.c7
-rw-r--r--erts/emulator/beam/erl_node_tables.c2
-rw-r--r--erts/emulator/beam/erl_port_task.c16
-rw-r--r--erts/emulator/beam/erl_port_task.h2
-rw-r--r--erts/emulator/beam/erl_process.c93
-rw-r--r--erts/emulator/beam/erl_process.h18
-rw-r--r--erts/emulator/beam/erl_ptab.c4
-rw-r--r--erts/emulator/beam/erl_ptab.h2
-rw-r--r--erts/emulator/beam/erl_thr_progress.h2
-rw-r--r--erts/emulator/beam/erl_trace.c130
-rw-r--r--erts/emulator/beam/erl_trace.h4
-rw-r--r--erts/emulator/beam/erl_unicode.c4
-rw-r--r--erts/emulator/beam/erl_zlib.c44
-rw-r--r--erts/emulator/beam/erl_zlib.h10
-rw-r--r--erts/emulator/beam/external.c634
-rwxr-xr-xerts/emulator/beam/global.h159
-rw-r--r--erts/emulator/beam/io.c26
-rw-r--r--erts/emulator/beam/utils.c30
-rw-r--r--erts/emulator/drivers/common/efile_drv.c4
-rw-r--r--erts/emulator/drivers/common/erl_efile.h2
-rw-r--r--erts/emulator/drivers/common/zlib_drv.c2
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c2
-rw-r--r--erts/emulator/drivers/win32/ttsl_drv.c2
-rw-r--r--erts/emulator/drivers/win32/win_efile.c2
-rw-r--r--erts/emulator/hipe/hipe_x86_signal.c2
-rw-r--r--erts/emulator/internal_doc/dec.erl2
-rw-r--r--erts/emulator/sys/common/erl_check_io.c16
-rw-r--r--erts/emulator/sys/common/erl_poll.c168
-rw-r--r--erts/emulator/sys/win32/sys_time.c50
-rw-r--r--erts/emulator/test/alloc_SUITE.erl2
-rw-r--r--erts/emulator/test/binary_SUITE.erl40
-rw-r--r--erts/emulator/test/code_parallel_load_SUITE.erl2
-rw-r--r--erts/emulator/test/port_SUITE.erl17
-rw-r--r--erts/emulator/test/send_term_SUITE.erl2
-rw-r--r--erts/emulator/test/trace_SUITE.erl71
52 files changed, 1500 insertions, 226 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index fb4cde0e76..58e83540e1 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -559,13 +559,14 @@ GENERATE += $(TTF_DIR)/driver_tab.c
# Preloaded code.
#
# This list must be consistent with PRE_LOADED_MODULES in
-# lib/kernel/src/Makefile.
+# erts/preloaded/src/Makefile.
ifeq ($(TARGET),win32)
# On windows the preloaded objects are in a resource object.
PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
PRELOAD_SRC = $(TARGET)/beams.rc
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
@@ -579,6 +580,7 @@ PRELOAD_OBJ = $(OBJDIR)/preload.o
PRELOAD_SRC = $(TARGET)/preload.c
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 7d86e486f1..eba1d0fa23 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -178,6 +178,7 @@ atom disable_trace
atom disabled
atom display_items
atom dist
+atom dist_cmd
atom Div='/'
atom div
atom dlink
@@ -313,6 +314,7 @@ atom load_cancelled
atom load_failure
atom local
atom long_gc
+atom long_schedule
atom low
atom Lt='<'
atom machine
@@ -432,6 +434,7 @@ atom port
atom ports
atom port_count
atom port_limit
+atom port_op
atom print
atom priority
atom private
@@ -443,6 +446,7 @@ atom process_display
atom process_limit
atom process_dump
atom procs
+atom proc_sig
atom profile
atom protected
atom protection
@@ -530,6 +534,7 @@ atom system_version
atom system_architecture
atom SYSTEM='SYSTEM'
atom table
+atom term_to_binary_trap
atom this
atom thread_pool_size
atom threads
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index ce025c9b6d..68907a771a 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2000-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2000-2013. 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
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 944ed6da81..5781009f58 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -924,6 +924,7 @@ extern int count_instructions;
# define NOINLINE
#endif
+
/*
* The following functions are called directly by process_main().
* Don't inline them.
@@ -1153,6 +1154,9 @@ void process_main(void)
Eterm pt_arity; /* Used by do_put_tuple */
+ Uint64 start_time = 0; /* Monitor long schedule */
+ BeamInstr* start_time_i = NULL;
+
ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */
@@ -1175,6 +1179,16 @@ void process_main(void)
do_schedule:
reds_used = REDS_IN(c_p) - FCALLS;
do_schedule1:
+
+ if (start_time != 0) {
+ Sint64 diff = erts_timestamp_millis() - start_time;
+ if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) {
+ BeamInstr *inptr = find_function_from_pc(start_time_i);
+ BeamInstr *outptr = find_function_from_pc(c_p->i);
+ monitor_long_schedule_proc(c_p,inptr,outptr,(Uint) diff);
+ }
+ }
+
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
#if HALFWORD_HEAP
@@ -1183,11 +1197,18 @@ void process_main(void)
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
c_p = schedule(c_p, reds_used);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ start_time = 0;
#ifdef DEBUG
pid = c_p->common.id; /* Save for debugging purpouses */
#endif
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
+
+ if (erts_system_monitor_long_schedule != 0) {
+ start_time = erts_timestamp_millis();
+ start_time_i = c_p->i;
+ }
+
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
@@ -6151,6 +6172,7 @@ apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg)
}
+
static Eterm
new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free)
{
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index 6f9b171224..6b43c53985 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2013. 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
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index f8cfd60a6f..ad9a89b642 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2013. 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
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 306a4f24de..5eacff8829 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -240,6 +240,10 @@ do { \
sys_memcpy((void *) (IP), (void *) &aui__, sizeof(struct au_init)); \
} while (0)
+#if ERTS_ALC_DEFAULT_ACUL \
+ || ERTS_ALC_DEFAULT_ACUL_LL_ALLOC \
+ || ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC
+
static ERTS_INLINE void
set_default_acul(struct au_init *ip, int acul)
{
@@ -249,6 +253,8 @@ set_default_acul(struct au_init *ip, int acul)
ip->init.util.acul = acul;
}
+#endif
+
static void
set_default_sl_alloc_opts(struct au_init *ip)
{
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index d9fdfc6f58..b5975c6c32 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2013. 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
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 095ad24387..bb5eba80be 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -150,6 +150,7 @@ type LINK_LH STANDARD PROCESSES link_lh
type SUSPEND_MON STANDARD PROCESSES suspend_monitor
type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend
type PROC_LIST SHORT_LIVED PROCESSES proc_list
+type EXTRA_ROOT SHORT_LIVED PROCESSES extra_root
type FUN_ENTRY LONG_LIVED CODE fun_entry
type ATOM_TXT LONG_LIVED ATOM atom_text
type BEAM_REGISTER EHEAP PROCESSES beam_register
@@ -397,6 +398,7 @@ type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req
type POLL_FDS LONG_LIVED SYSTEM poll_fds
type POLL_RES_EVS LONG_LIVED SYSTEM poll_result_events
type FD_STATUS LONG_LIVED SYSTEM fd_status
+type SELECT_FDS LONG_LIVED SYSTEM select_fds
+if unix
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index b19e603a5f..bf8a37c71b 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -1753,7 +1753,8 @@ handle_delayed_dealloc(Allctr_t *allctr,
if (IS_FREE_LAST_MBC_BLK(blk)) {
/*
* A multiblock carrier that previously has been migrated away
- * from us and now is back to be deallocated...
+ * from us and now is back to be deallocated. For more info
+ * see schedule_dealloc_carrier().
*
* Note that we cannot use FBLK_TO_MBC(blk) since it
* data has been overwritten by the queue.
@@ -1761,6 +1762,12 @@ handle_delayed_dealloc(Allctr_t *allctr,
Carrier_t *crr = FIRST_BLK_TO_MBC(allctr, blk);
ERTS_ALC_CPOOL_ASSERT(ERTS_ALC_IS_CPOOL_ENABLED(allctr));
ERTS_ALC_CPOOL_ASSERT(allctr == crr->cpool.orig_allctr);
+ ERTS_ALC_CPOOL_ASSERT(((erts_aint_t) allctr)
+ != (erts_smp_atomic_read_nob(&crr->allctr)
+ & ~FLG_MASK));
+
+ erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr));
+
schedule_dealloc_carrier(allctr, crr);
}
else {
@@ -3001,7 +3008,7 @@ check_pending_dealloc_carrier(Allctr_t *allctr,
static void
schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
{
- Allctr_t *used_allctr;
+ Allctr_t *orig_allctr;
int check_pending_dealloc;
erts_aint_t max_size;
@@ -3010,25 +3017,37 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
return;
}
- used_allctr = crr->cpool.orig_allctr;
+ orig_allctr = crr->cpool.orig_allctr;
- if (allctr != used_allctr) {
+ if (allctr != orig_allctr) {
Block_t *blk = MBC_TO_FIRST_BLK(allctr, crr);
- int cinit = used_allctr->dd.ix - allctr->dd.ix;
+ int cinit = orig_allctr->dd.ix - allctr->dd.ix;
/*
- * Receiver will recognize that this is a carrier to
- * deallocate since the block is an mbc block that
- * is free and last in carrier...
+ * We send the carrier to its origin for deallocation.
+ * This in order:
+ * - not to complicate things for the thread specific
+ * instances of mseg_alloc, and
+ * - to ensure that we always only reuse empty carriers
+ * originating from our own thread specific mseg_alloc
+ * instance which is beneficial on NUMA systems.
+ *
+ * The receiver will recognize that this is a carrier to
+ * deallocate (and not a block which is the common case)
+ * since the block is an mbc block that is free and last
+ * in the carrier.
*/
ERTS_ALC_CPOOL_ASSERT(IS_FREE_LAST_MBC_BLK(blk));
ERTS_ALC_CPOOL_ASSERT(IS_MBC_FIRST_ABLK(allctr, blk));
ERTS_ALC_CPOOL_ASSERT(crr == FBLK_TO_MBC(blk));
- ERTS_ALC_CPOOL_ASSERT(crr == FIRST_BLK_TO_MBC(used_allctr, blk));
+ ERTS_ALC_CPOOL_ASSERT(crr == FIRST_BLK_TO_MBC(allctr, blk));
+ ERTS_ALC_CPOOL_ASSERT(((erts_aint_t) allctr)
+ == (erts_smp_atomic_read_nob(&crr->allctr)
+ & ~FLG_MASK));
- if (ddq_enqueue(&used_allctr->dd.q, BLK2UMEM(blk), cinit))
- erts_alloc_notify_delayed_dealloc(used_allctr->ix);
+ if (ddq_enqueue(&orig_allctr->dd.q, BLK2UMEM(blk), cinit))
+ erts_alloc_notify_delayed_dealloc(orig_allctr->ix);
return;
}
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index 5e52b9b733..02cbe5c5d0 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2013. 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
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h
index 6fa2c0e5bf..25b344c6a8 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.h
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2013. 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
diff --git a/erts/emulator/beam/erl_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h
index be8b2b871d..870439e886 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.h
+++ b/erts/emulator/beam/erl_bestfit_alloc.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2013. 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
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 559cb3efa1..06fbbea123 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -2012,6 +2012,7 @@ void erts_system_monitor_clear(Process *c_p) {
#endif
erts_set_system_monitor(NIL);
erts_system_monitor_long_gc = 0;
+ erts_system_monitor_long_schedule = 0;
erts_system_monitor_large_heap = 0;
erts_system_monitor_flags.busy_port = 0;
erts_system_monitor_flags.busy_dist_port = 0;
@@ -2036,12 +2037,17 @@ static Eterm system_monitor_get(Process *p)
Uint hsz = 3 + (erts_system_monitor_flags.busy_dist_port ? 2 : 0) +
(erts_system_monitor_flags.busy_port ? 2 : 0);
Eterm long_gc = NIL;
+ Eterm long_schedule = NIL;
Eterm large_heap = NIL;
if (erts_system_monitor_long_gc != 0) {
hsz += 2+3;
(void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_gc);
}
+ if (erts_system_monitor_long_schedule != 0) {
+ hsz += 2+3;
+ (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_schedule);
+ }
if (erts_system_monitor_large_heap != 0) {
hsz += 2+3;
(void) erts_bld_uint(NULL, &hsz, erts_system_monitor_large_heap);
@@ -2051,6 +2057,10 @@ static Eterm system_monitor_get(Process *p)
if (erts_system_monitor_long_gc != 0) {
long_gc = erts_bld_uint(&hp, NULL, erts_system_monitor_long_gc);
}
+ if (erts_system_monitor_long_schedule != 0) {
+ long_schedule = erts_bld_uint(&hp, NULL,
+ erts_system_monitor_long_schedule);
+ }
if (erts_system_monitor_large_heap != 0) {
large_heap = erts_bld_uint(&hp, NULL, erts_system_monitor_large_heap);
}
@@ -2059,6 +2069,10 @@ static Eterm system_monitor_get(Process *p)
Eterm t = TUPLE2(hp, am_long_gc, long_gc); hp += 3;
res = CONS(hp, t, res); hp += 2;
}
+ if (long_schedule != NIL) {
+ Eterm t = TUPLE2(hp, am_long_schedule, long_schedule); hp += 3;
+ res = CONS(hp, t, res); hp += 2;
+ }
if (large_heap != NIL) {
Eterm t = TUPLE2(hp, am_large_heap, large_heap); hp += 3;
res = CONS(hp, t, res); hp += 2;
@@ -2113,7 +2127,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
}
if (is_not_list(list)) goto error;
else {
- Uint long_gc, large_heap;
+ Uint long_gc, long_schedule, large_heap;
int busy_port, busy_dist_port;
system_blocked = 1;
@@ -2123,7 +2137,8 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0))
goto error;
- for (long_gc = 0, large_heap = 0, busy_port = 0, busy_dist_port = 0;
+ for (long_gc = 0, long_schedule = 0, large_heap = 0,
+ busy_port = 0, busy_dist_port = 0;
is_list(list);
list = CDR(list_val(list))) {
Eterm t = CAR(list_val(list));
@@ -2133,6 +2148,9 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
if (tp[1] == am_long_gc) {
if (! term_to_Uint(tp[2], &long_gc)) goto error;
if (long_gc < 1) long_gc = 1;
+ } else if (tp[1] == am_long_schedule) {
+ if (! term_to_Uint(tp[2], &long_schedule)) goto error;
+ if (long_schedule < 1) long_schedule = 1;
} else if (tp[1] == am_large_heap) {
if (! term_to_Uint(tp[2], &large_heap)) goto error;
if (large_heap < 16384) large_heap = 16384;
@@ -2148,6 +2166,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list)
prev = system_monitor_get(p);
erts_set_system_monitor(monitor_pid);
erts_system_monitor_long_gc = long_gc;
+ erts_system_monitor_long_schedule = long_schedule;
erts_system_monitor_large_heap = large_heap;
erts_system_monitor_flags.busy_port = !!busy_port;
erts_system_monitor_flags.busy_dist_port = !!busy_dist_port;
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 0d12e658d9..8ba94d89e9 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1964,6 +1964,17 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
++n;
}
+ /*
+ * A trapping BIF can add to rootset by setting the extra_root
+ * in the process_structure.
+ */
+ if (p->extra_root != NULL) {
+ roots[n].v = p->extra_root->objv;
+ roots[n].sz = p->extra_root->sz;
+ ++n;
+ }
+
+
ASSERT((is_nil(p->seq_trace_token) ||
is_tuple(follow_moved(p->seq_trace_token)) ||
is_atom(p->seq_trace_token)));
@@ -2541,6 +2552,12 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
p->dictionary->used,
offs, area, area_size);
}
+ if (p->extra_root != NULL) {
+ offset_heap_ptr(p->extra_root->objv,
+ p->extra_root->sz,
+ offs, area, area_size);
+ }
+
offset_heap_ptr(&p->fvalue, 1, offs, area, area_size);
offset_heap_ptr(&p->ftrace, 1, offs, area, area_size);
offset_heap_ptr(&p->seq_trace_token, 1, offs, area, area_size);
diff --git a/erts/emulator/beam/erl_goodfit_alloc.h b/erts/emulator/beam/erl_goodfit_alloc.h
index 11bef77e7f..385de0da23 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.h
+++ b/erts/emulator/beam/erl_goodfit_alloc.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2013. 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
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index b3a3c3d403..4bae3dfeb4 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -340,6 +340,7 @@ erl_init(int ncpu,
erts_init_bif_binary();
erts_init_bif_re();
erts_init_unicode(); /* after RE to get access to PCRE unicode */
+ erts_init_external();
erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2);
erts_late_init_process();
#if HAVE_ERTS_MSEG
@@ -1479,6 +1480,22 @@ erl_start(int argc, char **argv)
("suggested scheduler thread stack size %d kilo words\n",
erts_sched_thread_suggested_stack_size));
}
+ else if (has_prefix("fwi", sub_param)) {
+ long val;
+ arg = get_arg(sub_param+3, argv[i+1], &i);
+ errno = 0;
+ val = strtol(arg, NULL, 10);
+ if (errno != 0 || val < 0) {
+ erts_fprintf(stderr,
+ "bad scheduler forced wakeup "
+ "interval %s\n",
+ arg);
+ erts_usage();
+ }
+#ifdef ERTS_SMP
+ erts_runq_supervision_interval = val;
+#endif
+ }
else {
erts_fprintf(stderr, "bad scheduling option %s\n", argv[i]);
erts_usage();
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index bc59fe55d4..2114d0c001 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2013. 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
@@ -180,6 +180,11 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "efile_drv dtrace mutex", NULL },
#endif
{ "mtrace_buf", NULL },
+#ifdef __WIN32__
+#ifdef ERTS_SMP
+ { "sys_gethrtime", NULL },
+#endif
+#endif
{ "erts_alloc_hard_debug", NULL }
};
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index e688e55c88..c6d136f951 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2013. 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
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 53cb01a8c6..7d53ce7152 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1594,6 +1594,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
int fpe_was_unmasked;
erts_aint32_t state;
int active;
+ Uint64 start_time = 0;
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
@@ -1655,6 +1656,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
reset_handle(ptp);
+ if (erts_system_monitor_long_schedule != 0) {
+ start_time = erts_timestamp_millis();
+ }
+
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp));
ERTS_SMP_CHK_NO_PROC_LOCKS;
ASSERT(pp->drv_ptr);
@@ -1723,6 +1728,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
reds += erts_port_driver_callback_epilogue(pp, &state);
+ if (start_time != 0) {
+ Sint64 diff = erts_timestamp_millis() - start_time;
+ if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) {
+ monitor_long_schedule_port(pp,ptp->type,(Uint) diff);
+ }
+ }
+ start_time = 0;
+
aborted_port_task:
schedule_port_task_free(ptp);
@@ -1928,18 +1941,21 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
break;
case ERTS_PORT_TASK_INPUT:
erts_stale_drv_select(pp->common.id,
+ ERTS_Port2ErlDrvPort(pp),
ptp->u.alive.td.io.event,
DO_READ,
1);
break;
case ERTS_PORT_TASK_OUTPUT:
erts_stale_drv_select(pp->common.id,
+ ERTS_Port2ErlDrvPort(pp),
ptp->u.alive.td.io.event,
DO_WRITE,
1);
break;
case ERTS_PORT_TASK_EVENT:
erts_stale_drv_select(pp->common.id,
+ ERTS_Port2ErlDrvPort(pp),
ptp->u.alive.td.io.event,
0,
1);
diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h
index d35a15c27b..e4d964146e 100644
--- a/erts/emulator/beam/erl_port_task.h
+++ b/erts/emulator/beam/erl_port_task.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2013. 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
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 88eb224f84..2439a46ab6 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -246,6 +246,10 @@ static erts_smp_atomic32_t function_calls;
#ifdef ERTS_SMP
static erts_smp_atomic32_t doing_sys_schedule;
static erts_smp_atomic32_t no_empty_run_queues;
+long erts_runq_supervision_interval = 0;
+static ethr_event runq_supervision_event;
+static erts_tid_t runq_supervisor_tid;
+static erts_atomic_t runq_supervisor_sleeping;
#else /* !ERTS_SMP */
ErtsSchedulerData *erts_scheduler_data;
#endif
@@ -267,6 +271,7 @@ static Uint last_exact_reductions;
Uint erts_default_process_flags;
Eterm erts_system_monitor;
Eterm erts_system_monitor_long_gc;
+Uint erts_system_monitor_long_schedule;
Eterm erts_system_monitor_large_heap;
struct erts_system_monitor_flags_t erts_system_monitor_flags;
@@ -2044,7 +2049,13 @@ empty_runq(ErtsRunQueue *rq)
*/
ASSERT(0 <= empty && empty < 2*erts_no_run_queues);
#endif
- erts_smp_atomic32_inc_relb(&no_empty_run_queues);
+ if (!erts_runq_supervision_interval)
+ erts_smp_atomic32_inc_relb(&no_empty_run_queues);
+ else {
+ erts_smp_atomic32_inc_mb(&no_empty_run_queues);
+ if (erts_atomic_read_nob(&runq_supervisor_sleeping))
+ ethr_event_set(&runq_supervision_event);
+ }
}
}
@@ -2061,7 +2072,14 @@ non_empty_runq(ErtsRunQueue *rq)
*/
ASSERT(0 < empty && empty <= 2*erts_no_run_queues);
#endif
- erts_smp_atomic32_dec_relb(&no_empty_run_queues);
+ if (!erts_runq_supervision_interval)
+ erts_smp_atomic32_dec_relb(&no_empty_run_queues);
+ else {
+ erts_aint32_t no;
+ no = erts_smp_atomic32_dec_read_mb(&no_empty_run_queues);
+ if (no > 0 && erts_atomic_read_nob(&runq_supervisor_sleeping))
+ ethr_event_set(&runq_supervision_event);
+ }
}
}
@@ -2665,7 +2683,6 @@ try_inc_no_active_runqs(int active)
return 0;
}
-
static ERTS_INLINE int
chk_wake_sched(ErtsRunQueue *crq, int ix, int activate)
{
@@ -4331,6 +4348,53 @@ set_wakeup_other_data(void)
}
}
+static int
+no_runqs_to_supervise(void)
+{
+ int used;
+ erts_aint32_t nerq = erts_smp_atomic32_read_acqb(&no_empty_run_queues);
+ if (nerq <= 0)
+ return 0;
+ get_no_runqs(NULL, &used);
+ if (nerq >= used)
+ return 0;
+ return used;
+}
+
+static void *
+runq_supervisor(void *unused)
+{
+ while (1) {
+ int ix, no_rqs;
+
+ erts_milli_sleep(erts_runq_supervision_interval);
+ no_rqs = no_runqs_to_supervise();
+ if (!no_rqs) {
+ erts_atomic_set_nob(&runq_supervisor_sleeping, 1);
+ while (1) {
+ ethr_event_reset(&runq_supervision_event);
+ no_rqs = no_runqs_to_supervise();
+ if (no_rqs) {
+ erts_atomic_set_nob(&runq_supervisor_sleeping, 0);
+ break;
+ }
+ ethr_event_wait(&runq_supervision_event);
+ }
+ }
+
+ for (ix = 0; ix < no_rqs; ix++) {
+ ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
+ if (ERTS_RUNQ_FLGS_GET(rq) & ERTS_RUNQ_FLG_NONEMPTY) {
+ erts_smp_runq_lock(rq);
+ if (rq->len != 0)
+ wake_scheduler_on_empty_runq(rq); /* forced wakeup... */
+ erts_smp_runq_unlock(rq);
+ }
+ }
+ }
+ return NULL;
+}
+
#endif
void
@@ -5754,6 +5818,22 @@ erts_start_schedulers(void)
ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER;
opts.detached = 1;
+
+#ifdef ERTS_SMP
+ if (erts_runq_supervision_interval) {
+ opts.suggested_stack_size = 16;
+ erts_atomic_init_nob(&runq_supervisor_sleeping, 0);
+ if (0 != ethr_event_init(&runq_supervision_event))
+ erl_exit(1, "Failed to create run-queue supervision event\n");
+ if (0 != ethr_thr_create(&runq_supervisor_tid,
+ runq_supervisor,
+ NULL,
+ &opts))
+ erl_exit(1, "Failed to create run-queue supervision thread\n");
+
+ }
+#endif
+
opts.suggested_stack_size = erts_sched_thread_suggested_stack_size;
if (wanted < 1)
@@ -7512,6 +7592,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->htop = p->heap;
p->heap_sz = sz;
p->catches = 0;
+ p->extra_root = NULL;
p->bin_vheap_sz = p->min_vheap_size;
p->bin_old_vheap_sz = p->min_vheap_size;
@@ -8944,6 +9025,12 @@ erts_continue_exit_process(Process *p)
if (pbt)
erts_free(ERTS_ALC_T_BPD, (void *) pbt);
+ if (p->extra_root != NULL) {
+ (p->extra_root->cleanup)(p->extra_root); /* Should deallocate
+ whole structure */
+ p->extra_root = NULL;
+ }
+
delete_process(p);
#ifdef ERTS_SMP
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 865ac6c43f..8e5467f196 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2013. 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
@@ -387,6 +387,10 @@ struct ErtsRunQueue_ {
} ports;
};
+#ifdef ERTS_SMP
+extern long erts_runq_supervision_interval;
+#endif
+
typedef union {
ErtsRunQueue runq;
char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsRunQueue))];
@@ -699,6 +703,14 @@ struct ErtsPendingSuspend_ {
#endif
+
+typedef struct ErlExtraRootSet_ ErlExtraRootSet;
+struct ErlExtraRootSet_ {
+ Eterm *objv;
+ Uint sz;
+ void (*cleanup)(ErlExtraRootSet *);
+};
+
/* Defines to ease the change of memory architecture */
# define HEAP_START(p) (p)->heap
# define HEAP_TOP(p) (p)->htop
@@ -792,6 +804,8 @@ struct process {
ErlMessageQueue msg; /* Message queue */
+ ErlExtraRootSet *extra_root; /* Used by trapping BIF's */
+
union {
ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */
void *terminate;
@@ -1009,6 +1023,7 @@ extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx;
*/
extern Eterm erts_system_monitor;
extern Uint erts_system_monitor_long_gc;
+extern Uint erts_system_monitor_long_schedule;
extern Uint erts_system_monitor_large_heap;
struct erts_system_monitor_flags_t {
unsigned int busy_port : 1;
@@ -1975,6 +1990,7 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi)
}
}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
#endif /* #ifdef ERTS_SMP */
diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c
index 8da135b2c8..d69619dd44 100644
--- a/erts/emulator/beam/erl_ptab.c
+++ b/erts/emulator/beam/erl_ptab.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2013. 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
@@ -1435,7 +1435,7 @@ erts_ptab_test_next_id(ErtsPTab *ptab, int set, Uint next)
aid_ix = max_ix;
else
aid_ix--;
- ASSERT((aid_ix & max_ix) == (((Uint32) erts_atomic32_read_nob(&ptab->vola.tile.fid_ix)) & max_ix));
+ ASSERT((aid_ix & max_ix) == (((Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.fid_ix)) & max_ix));
#endif
}
diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h
index 84ff7d0de4..c2d8bd9cad 100644
--- a/erts/emulator/beam/erl_ptab.h
+++ b/erts/emulator/beam/erl_ptab.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2013. 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
diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h
index 1aeecf2b06..5f392944c2 100644
--- a/erts/emulator/beam/erl_thr_progress.h
+++ b/erts/emulator/beam/erl_thr_progress.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2011-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2011-2013. 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
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index 848877d43e..fa015ee4b9 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1999-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1999-2013. 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
@@ -2268,7 +2268,134 @@ trace_gc(Process *p, Eterm what)
#undef LOCAL_HEAP_SIZE
}
+void
+monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time)
+{
+ ErlHeapFragment *bp;
+ ErlOffHeap *off_heap;
+#ifndef ERTS_SMP
+ Process *monitor_p;
+#endif
+ Uint hsz;
+ Eterm *hp, list, in_mfa = am_undefined, out_mfa = am_undefined;
+ Eterm in_tpl, out_tpl, tmo_tpl, tmo, msg;
+
+
+#ifndef ERTS_SMP
+ ASSERT(is_internal_pid(system_monitor));
+ monitor_p = erts_proc_lookup(system_monitor);
+ if (!monitor_p || p == monitor_p) {
+ return;
+ }
+#endif
+ /*
+ * Size: {monitor, pid, long_schedule, [{timeout, T}, {in, {M,F,A}},{out,{M,F,A}}]} ->
+ * 5 (top tuple of 4), (3 (elements) * 2 (cons)) + 3 (timeout tuple of 2) + size of Timeout +
+ * (2 * 3 (in/out tuple of 2)) +
+ * 0 (unknown) or 4 (MFA tuple of 3) + 0 (unknown) or 4 (MFA tuple of 3)
+ * = 20 + (in_fp != NULL) ? 4 : 0 + (out_fp != NULL) ? 4 : 0 + size of Timeout
+ */
+ hsz = 20 + ((in_fp != NULL) ? 4 : 0) + ((out_fp != NULL) ? 4 : 0);
+ (void) erts_bld_uint(NULL, &hsz, time);
+ hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p);
+ tmo = erts_bld_uint(&hp, NULL, time);
+ if (in_fp != NULL) {
+ in_mfa = TUPLE3(hp,(Eterm) in_fp[0], (Eterm) in_fp[1], make_small(in_fp[2]));
+ hp +=4;
+ }
+ if (out_fp != NULL) {
+ out_mfa = TUPLE3(hp,(Eterm) out_fp[0], (Eterm) out_fp[1], make_small(out_fp[2]));
+ hp +=4;
+ }
+ tmo_tpl = TUPLE2(hp,am_timeout, tmo);
+ hp += 3;
+ in_tpl = TUPLE2(hp,am_in,in_mfa);
+ hp += 3;
+ out_tpl = TUPLE2(hp,am_out,out_mfa);
+ hp += 3;
+ list = CONS(hp,out_tpl,NIL);
+ hp += 2;
+ list = CONS(hp,in_tpl,list);
+ hp += 2;
+ list = CONS(hp,tmo_tpl,list);
+ hp += 2;
+ msg = TUPLE4(hp, am_monitor, p->common.id, am_long_schedule, list);
+ hp += 5;
+#ifdef ERTS_SMP
+ enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
+#else
+ erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef USE_VM_PROBES
+ , NIL
+#endif
+ );
+#endif
+}
+void
+monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
+{
+ ErlHeapFragment *bp;
+ ErlOffHeap *off_heap;
+#ifndef ERTS_SMP
+ Process *monitor_p;
+#endif
+ Uint hsz;
+ Eterm *hp, list, op;
+ Eterm op_tpl, tmo_tpl, tmo, msg;
+
+
+#ifndef ERTS_SMP
+ ASSERT(is_internal_pid(system_monitor));
+ monitor_p = erts_proc_lookup(system_monitor);
+ if (!monitor_p) {
+ return;
+ }
+#endif
+ /*
+ * Size: {monitor, port, long_schedule, [{timeout, T}, {op, Operation}]} ->
+ * 5 (top tuple of 4), (2 (elements) * 2 (cons)) + 3 (timeout tuple of 2)
+ * + size of Timeout + 3 (op tuple of 2 atoms)
+ * = 15 + size of Timeout
+ */
+ hsz = 15;
+ (void) erts_bld_uint(NULL, &hsz, time);
+
+ hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p);
+ switch (type) {
+ case ERTS_PORT_TASK_PROC_SIG: op = am_proc_sig; break;
+ case ERTS_PORT_TASK_TIMEOUT: op = am_timeout; break;
+ case ERTS_PORT_TASK_INPUT: op = am_input; break;
+ case ERTS_PORT_TASK_OUTPUT: op = am_output; break;
+ case ERTS_PORT_TASK_EVENT: op = am_event; break;
+ case ERTS_PORT_TASK_DIST_CMD: op = am_dist_cmd; break;
+ default: op = am_undefined; break;
+ }
+
+ tmo = erts_bld_uint(&hp, NULL, time);
+
+ op_tpl = TUPLE2(hp,am_port_op,op);
+ hp += 3;
+
+ tmo_tpl = TUPLE2(hp,am_timeout, tmo);
+ hp += 3;
+
+ list = CONS(hp,op_tpl,NIL);
+ hp += 2;
+ list = CONS(hp,tmo_tpl,list);
+ hp += 2;
+ msg = TUPLE4(hp, am_monitor, pp->common.id, am_long_schedule, list);
+ hp += 5;
+#ifdef ERTS_SMP
+ enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp);
+#else
+ erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef USE_VM_PROBES
+ , NIL
+#endif
+ );
+#endif
+}
void
monitor_long_gc(Process *p, Uint time) {
@@ -3011,6 +3138,7 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver)
case SYS_MSG_TYPE_SYSMON:
if (receiver == NIL
&& !erts_system_monitor_long_gc
+ && !erts_system_monitor_long_schedule
&& !erts_system_monitor_large_heap
&& !erts_system_monitor_flags.busy_port
&& !erts_system_monitor_flags.busy_dist_port)
diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 50fb27aab0..853c6cb0d8 100644
--- a/erts/emulator/beam/erl_trace.h
+++ b/erts/emulator/beam/erl_trace.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2012. All Rights Reserved.
+ * Copyright Ericsson AB 2012-2013. 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
@@ -83,6 +83,8 @@ void erts_system_profile_setup_active_schedulers(void);
/* system_monitor */
void monitor_long_gc(Process *p, Uint time);
+void monitor_long_schedule_proc(Process *p, BeamInstr *in_i, BeamInstr *out_i, Uint time);
+void monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time);
void monitor_large_heap(Process *p);
void monitor_generic(Process *p, Eterm type, Eterm spec);
Uint erts_trace_flag2bit(Eterm flag);
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index ad6f8b993a..e00440b905 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -1723,14 +1723,14 @@ static BIF_RETTYPE do_bif_utf8_to_list(Process *p,
if (b_sz) {
ErlSubBin *sb;
Eterm orig;
- ERTS_DECLARE_DUMMY(Uint offset);
+ Uint offset;
ASSERT(state != ERTS_UTF8_OK);
hp = HAlloc(p, ERL_SUB_BIN_SIZE);
sb = (ErlSubBin *) hp;
ERTS_GET_REAL_BIN(orig_bin, orig, offset, bitoffs, bitsize);
sb->thing_word = HEADER_SUB_BIN;
sb->size = b_sz;
- sb->offs = num_bytes_to_process + num_processed_bytes;
+ sb->offs = offset + num_bytes_to_process + num_processed_bytes;
sb->orig = orig;
sb->bitoffs = bitoffs;
sb->bitsize = bitsize;
diff --git a/erts/emulator/beam/erl_zlib.c b/erts/emulator/beam/erl_zlib.c
index f73d48b6c2..47fd92988e 100644
--- a/erts/emulator/beam/erl_zlib.c
+++ b/erts/emulator/beam/erl_zlib.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2013. 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
@@ -44,6 +44,48 @@ void erl_zlib_zfree_callback (voidpf opaque, voidpf ptr)
erts_free(ERTS_ALC_T_ZLIB, ptr);
}
+/*
+ * Initialize a z_stream with a source, to later *chunk* data into a destination
+ * Returns Z_OK or Error.
+ */
+int ZEXPORT erl_zlib_deflate_start(z_stream *streamp, const Bytef* source,
+ uLong sourceLen, int level)
+{
+ streamp->next_in = (Bytef*)source;
+ streamp->avail_in = (uInt)sourceLen;
+ streamp->total_out = streamp->avail_out = 0;
+ streamp->next_out = NULL;
+ erl_zlib_alloc_init(streamp);
+ return deflateInit(streamp, level);
+}
+/*
+ * Deflate a chunk, The destination length is the limit.
+ * Returns Z_OK if more to process, Z_STREAM_END if we are done.
+ */
+int ZEXPORT erl_zlib_deflate_chunk(z_stream *streamp, Bytef* dest, uLongf* destLen)
+{
+ int err;
+ uLongf last_tot = streamp->total_out;
+
+ streamp->next_out = dest;
+ streamp->avail_out = (uInt)*destLen;
+
+ if ((uLong)streamp->avail_out != *destLen) return Z_BUF_ERROR;
+
+ err = deflate(streamp, Z_FINISH);
+ *destLen = streamp->total_out - last_tot;
+ return err;
+}
+
+
+/*
+ * When we are done, free up the deflate structure
+ * Retyurns Z_OK or Error
+ */
+int ZEXPORT erl_zlib_deflate_finish(z_stream *streamp)
+{
+ return deflateEnd(streamp);
+}
int ZEXPORT erl_zlib_compress2 (Bytef* dest, uLongf* destLen,
const Bytef* source, uLong sourceLen,
diff --git a/erts/emulator/beam/erl_zlib.h b/erts/emulator/beam/erl_zlib.h
index 9054a5e428..5ac849d21c 100644
--- a/erts/emulator/beam/erl_zlib.h
+++ b/erts/emulator/beam/erl_zlib.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2013. 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
@@ -31,6 +31,14 @@
(s)->zfree = erl_zlib_zfree_callback; \
} while (0)
+/*
+ * Chunked interface, used by term_to_binary among others.
+ */
+int ZEXPORT erl_zlib_deflate_start(z_stream *streamp, const Bytef* source,
+ uLong sourceLen, int level);
+int ZEXPORT erl_zlib_deflate_chunk(z_stream *streamp, Bytef* dest, uLongf* destLen);
+int ZEXPORT erl_zlib_deflate_finish(z_stream *streamp);
+
/* Use instead of compress
*/
#define erl_zlib_compress(dest,destLen,source,sourceLen) \
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 8420cfae24..249b1e0923 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -81,7 +81,11 @@
*
*/
+static Export term_to_binary_trap_export;
+
static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap);
+static int enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
+ struct erl_off_heap_header** off_heap, Sint *reds, byte **res);
static Uint is_external_string(Eterm obj, int* p_is_string);
static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
@@ -89,9 +93,31 @@ 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 internal_tags);
+static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1);
+static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags,
+ Binary *context_b);
static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned);
+static int encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj,
+ unsigned dflags, Sint *reds, Uint *res);
+
+void erts_init_external(void) {
+#if 1 /* In R16 */
+ erts_init_trap_export(&term_to_binary_trap_export,
+ am_erlang, am_term_to_binary_trap, 1,
+ &term_to_binary_trap_1);
+#else
+ sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export));
+ term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3];
+ term_to_binary_trap_export.code[0] = am_erlang;
+ term_to_binary_trap_export.code[1] = am_term_to_binary_trap;
+ term_to_binary_trap_export.code[2] = 1;
+ term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif;
+ term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1;
+#endif
+ return;
+}
#define ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES 255
@@ -1009,10 +1035,28 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
}
-
+static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1)
+{
+ Eterm *tp = tuple_val(BIF_ARG_1);
+ Eterm Term = tp[1];
+ Eterm bt = tp[2];
+ Binary *bin = ((ProcBin *) binary_val(bt))->val;
+ Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin);
+ if (is_tuple(res)) {
+ BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res);
+ } else {
+ BIF_RET(res);
+ }
+}
+
BIF_RETTYPE term_to_binary_1(BIF_ALIST_1)
{
- return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS);
+ Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL);
+ if (is_tuple(res)) {
+ BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res);
+ } else {
+ BIF_RET(res);
+ }
}
BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
@@ -1022,6 +1066,8 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
Eterm Flags = BIF_ARG_2;
int level = 0;
Uint flags = TERM_TO_BINARY_DFLAGS;
+ Eterm res;
+ Binary *bin = NULL;
while (is_list(Flags)) {
Eterm arg = CAR(list_val(Flags));
@@ -1058,7 +1104,12 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2)
goto error;
}
- return erts_term_to_binary(p, Term, level, flags);
+ res = erts_term_to_binary_int(p, Term, level, flags, bin);
+ if (is_tuple(res)) {
+ BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res);
+ } else {
+ BIF_RET(res);
+ }
}
static uLongf binary2term_uncomp_size(byte* data, Sint size)
@@ -1335,16 +1386,13 @@ external_size_2(BIF_ALIST_2)
}
}
-Eterm
-erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags)
+static Eterm
+erts_term_to_binary_simple(Process* p, Eterm Term, Uint size, int level, Uint flags)
{
- Uint size;
Eterm bin;
size_t real_size;
byte* endp;
- size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */;
-
if (level != 0) {
byte buf[256];
byte* bytes = buf;
@@ -1414,6 +1462,327 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags)
}
}
+Eterm
+erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) {
+ Uint size;
+ size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */;
+ return erts_term_to_binary_simple(p, Term, size, level, flags);
+}
+
+/* Define for testing */
+/* #define EXTREME_TTB_TRAPPING 1 */
+
+#ifndef EXTREME_TTB_TRAPPING
+#define TERM_TO_BINARY_LOOP_FACTOR 500
+#define TERM_TO_BINARY_SIZE_FACTOR 500000
+#define TERM_TO_BINARY_COMPRESS_CHUNK 500000
+#else
+#define TERM_TO_BINARY_LOOP_FACTOR 1
+#define TERM_TO_BINARY_SIZE_FACTOR 10
+#define TERM_TO_BINARY_COMPRESS_CHUNK 10
+#endif
+
+
+typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState;
+typedef struct {
+ Uint flags;
+ int level;
+} TTBSizeContext;
+
+typedef struct {
+ Uint flags;
+ int level;
+ Binary *result_bin;
+} TTBEncodeContext;
+
+typedef struct {
+ Uint real_size;
+ Uint dest_len;
+ byte *dbytes;
+ Binary *result_bin;
+ Binary *destination_bin;
+ z_stream stream;
+} TTBCompressContext;
+
+typedef struct {
+ int alive;
+ TTBState state;
+ union {
+ TTBSizeContext sc;
+ TTBEncodeContext ec;
+ TTBCompressContext cc;
+ } s;
+} TTBContext;
+
+static void context_destructor(Binary *context_bin)
+{
+ TTBContext *context = ERTS_MAGIC_BIN_DATA(context_bin);
+ if (context->alive) {
+ context->alive = 0;
+ switch (context->state) {
+ case TTBSize:
+ break;
+ case TTBEncode:
+ if (context->s.ec.result_bin != NULL) { /* Set to NULL if ever made alive! */
+ ASSERT(erts_refc_read(&(context->s.ec.result_bin->refc),0) == 0);
+ erts_bin_free(context->s.ec.result_bin);
+ context->s.ec.result_bin = NULL;
+ }
+ break;
+ case TTBCompress:
+ erl_zlib_deflate_finish(&(context->s.cc.stream));
+
+ if (context->s.cc.destination_bin != NULL) { /* Set to NULL if ever made alive! */
+ ASSERT(erts_refc_read(&(context->s.cc.destination_bin->refc),0) == 0);
+ erts_bin_free(context->s.cc.destination_bin);
+ context->s.cc.destination_bin = NULL;
+ }
+
+ if (context->s.cc.result_bin != NULL) { /* Set to NULL if ever made alive! */
+ ASSERT(erts_refc_read(&(context->s.cc.result_bin->refc),0) == 0);
+ erts_bin_free(context->s.cc.result_bin);
+ context->s.cc.result_bin = NULL;
+ }
+ break;
+ }
+ }
+}
+
+static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags,
+ Binary *context_b)
+{
+ Eterm *hp;
+ Eterm res;
+ Eterm c_term;
+#ifndef EXTREME_TTB_TRAPPING
+ Sint reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
+#else
+ Sint reds = 20; /* For testing */
+#endif
+ Sint initial_reds = reds;
+ TTBContext c_buff;
+ TTBContext *context = &c_buff;
+
+#define EXPORT_CONTEXT() \
+ do { \
+ if (context_b == NULL) { \
+ context_b = erts_create_magic_binary(sizeof(TTBContext), \
+ context_destructor); \
+ context = ERTS_MAGIC_BIN_DATA(context_b); \
+ memcpy(context,&c_buff,sizeof(TTBContext)); \
+ } \
+ } while (0)
+
+#define RETURN_STATE() \
+ do { \
+ hp = HAlloc(p, PROC_BIN_SIZE+3); \
+ c_term = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); \
+ res = TUPLE2(hp, Term, c_term); \
+ BUMP_ALL_REDS(p); \
+ return res; \
+ } while (0);
+
+
+ if (context_b == NULL) {
+ /* Setup enough to get started */
+ context->state = TTBSize;
+ context->alive = 1;
+ context->s.sc.flags = flags;
+ context->s.sc.level = level;
+ } else {
+ context = ERTS_MAGIC_BIN_DATA(context_b);
+ }
+ /* Initialization done, now we will go through the states */
+ for (;;) {
+ switch (context->state) {
+ case TTBSize:
+ {
+ Uint size;
+ Binary *result_bin;
+ int level;
+ Uint flags;
+ /* Try for fast path */
+ if (encode_size_struct_int(p, NULL, Term, context->s.sc.flags, &reds, &size) < 0) {
+ EXPORT_CONTEXT();
+ /* Same state */
+ RETURN_STATE();
+ }
+ ++size; /* VERSION_MAGIC */
+ /* Move these to next state */
+ flags = context->s.sc.flags;
+ level = context->s.sc.level;
+ if (size <= ERL_ONHEAP_BIN_LIMIT) {
+ /* Finish in one go */
+ res = erts_term_to_binary_simple(p, Term, size,
+ level, flags);
+ BUMP_REDS(p, size / TERM_TO_BINARY_SIZE_FACTOR);
+ return res;
+ }
+
+ result_bin = erts_bin_nrml_alloc(size);
+ result_bin->flags = 0;
+ result_bin->orig_size = size;
+ erts_refc_init(&result_bin->refc, 0);
+ result_bin->orig_bytes[0] = VERSION_MAGIC;
+ /* Next state immediately, no need to export context */
+ context->state = TTBEncode;
+ context->s.ec.flags = flags;
+ context->s.ec.level = level;
+ context->s.ec.result_bin = result_bin;
+ break;
+ }
+ case TTBEncode:
+ {
+ byte *endp;
+ byte *bytes = (byte *) context->s.ec.result_bin->orig_bytes;
+ size_t real_size;
+ Binary *result_bin;
+
+ flags = context->s.ec.flags;
+ if (enc_term_int(p,NULL,Term, bytes+1, flags, NULL, &reds, &endp) < 0) {
+ EXPORT_CONTEXT();
+ RETURN_STATE();
+ }
+ real_size = endp - bytes;
+ result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size);
+ level = context->s.ec.level;
+ BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR);
+ if (level == 0 || real_size < 6) { /* We are done */
+ ProcBin* pb;
+ return_normal:
+ context->s.ec.result_bin = NULL;
+ context->alive = 0;
+ pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = real_size;
+ pb->next = MSO(p).first;
+ MSO(p).first = (struct erl_off_heap_header*)pb;
+ pb->val = result_bin;
+ pb->bytes = (byte*) result_bin->orig_bytes;
+ pb->flags = 0;
+ OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
+ erts_refc_inc(&result_bin->refc, 1);
+ if (context_b && erts_refc_read(&context_b->refc,0) == 0) {
+ erts_bin_free(context_b);
+ }
+ return make_binary(pb);
+ }
+ /* Continue with compression... */
+ /* To make absolutely sure that zlib does not barf on a reallocated context,
+ we make sure it's "exported" before doing anything compession-like */
+ EXPORT_CONTEXT();
+ bytes = (byte *) result_bin->orig_bytes; /* result_bin is reallocated */
+ if (erl_zlib_deflate_start(&(context->s.cc.stream),bytes+1,real_size-1,level)
+ != Z_OK) {
+ goto return_normal;
+ }
+ context->state = TTBCompress;
+ context->s.cc.real_size = real_size;
+ context->s.cc.result_bin = result_bin;
+
+ result_bin = erts_bin_nrml_alloc(real_size);
+ result_bin->flags = 0;
+ result_bin->orig_size = real_size;
+ erts_refc_init(&result_bin->refc, 0);
+ result_bin->orig_bytes[0] = VERSION_MAGIC;
+
+ context->s.cc.destination_bin = result_bin;
+ context->s.cc.dest_len = 0;
+ context->s.cc.dbytes = (byte *) result_bin->orig_bytes+6;
+ break;
+ }
+ case TTBCompress:
+ {
+ uLongf tot_dest_len = context->s.cc.real_size - 6;
+ uLongf left = (tot_dest_len - context->s.cc.dest_len);
+ uLongf this_time = (left > TERM_TO_BINARY_COMPRESS_CHUNK) ?
+ TERM_TO_BINARY_COMPRESS_CHUNK :
+ left;
+ Binary *result_bin;
+ ProcBin *pb;
+ Uint max = (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_COMPRESS_CHUNK) / CONTEXT_REDS;
+
+ if (max < this_time) {
+ this_time = max + 1; /* do not set this_time to 0 */
+ }
+
+ res = erl_zlib_deflate_chunk(&(context->s.cc.stream), context->s.cc.dbytes, &this_time);
+ context->s.cc.dbytes += this_time;
+ context->s.cc.dest_len += this_time;
+ switch (res) {
+ case Z_OK:
+ if (context->s.cc.dest_len >= tot_dest_len) {
+ goto no_use_compressing;
+ }
+ RETURN_STATE();
+ case Z_STREAM_END:
+ {
+ byte *dbytes = (byte *) context->s.cc.destination_bin->orig_bytes + 1;
+
+ dbytes[0] = COMPRESSED;
+ put_int32(context->s.cc.real_size-1,dbytes+1);
+ erl_zlib_deflate_finish(&(context->s.cc.stream));
+ result_bin = erts_bin_realloc(context->s.cc.destination_bin,
+ context->s.cc.dest_len+6);
+ context->s.cc.destination_bin = NULL;
+ pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = context->s.cc.dest_len+6;
+ pb->next = MSO(p).first;
+ MSO(p).first = (struct erl_off_heap_header*)pb;
+ pb->val = result_bin;
+ pb->bytes = (byte*) result_bin->orig_bytes;
+ pb->flags = 0;
+ OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
+ erts_refc_inc(&result_bin->refc, 1);
+ erts_bin_free(context->s.cc.result_bin);
+ context->s.cc.result_bin = NULL;
+ context->alive = 0;
+ BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK);
+ if (context_b && erts_refc_read(&context_b->refc,0) == 0) {
+ erts_bin_free(context_b);
+ }
+ return make_binary(pb);
+ }
+ default: /* Compression error, revert to uncompressed binary (still in
+ context) */
+ no_use_compressing:
+ result_bin = context->s.cc.result_bin;
+ context->s.cc.result_bin = NULL;
+ pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE);
+ pb->thing_word = HEADER_PROC_BIN;
+ pb->size = context->s.cc.real_size;
+ pb->next = MSO(p).first;
+ MSO(p).first = (struct erl_off_heap_header*)pb;
+ pb->val = result_bin;
+ pb->bytes = (byte*) result_bin->orig_bytes;
+ pb->flags = 0;
+ OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm));
+ erts_refc_inc(&result_bin->refc, 1);
+ erl_zlib_deflate_finish(&(context->s.cc.stream));
+ erts_bin_free(context->s.cc.destination_bin);
+ context->s.cc.destination_bin = NULL;
+ context->alive = 0;
+ BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK);
+ if (context_b && erts_refc_read(&context_b->refc,0) == 0) {
+ erts_bin_free(context_b);
+ }
+ return make_binary(pb);
+ }
+ }
+ }
+ }
+#undef EXPORT_CONTEXT
+#undef RETURN_STATE
+}
+
+
+
+
+
+
+
+
/*
* This function fills ext with the external format of atom.
* If it's an old atom we just supply an index, otherwise
@@ -1678,32 +2047,71 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete
#define ENC_PATCH_FUN_SIZE ((Eterm) 2)
#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3)
+/* Free extra rootset (used when trapping) */
+static void cleanup_ttb_extra_root(ErlExtraRootSet *rs)
+{
+ if (rs->objv != NULL) {
+ erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv);
+ }
+ erts_free(ERTS_ALC_T_EXTRA_ROOT, rs);
+}
+
+/* Same as above, but we have an extra "stack" beyond GC reach, i.e. an array of two extra roots */
+static void cleanup_ttb_extra_root_2(ErlExtraRootSet *rs)
+{
+ if (rs->objv != NULL) {
+ erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv);
+ }
+ if (rs[1].objv != NULL) {
+ erts_free(ERTS_ALC_T_EXTRA_ROOT, rs[1].objv);
+ }
+
+ erts_free(ERTS_ALC_T_EXTRA_ROOT, rs);
+}
+
static byte*
enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
struct erl_off_heap_header** off_heap)
{
- DECLARE_WSTACK(s);
+ byte *res;
+ (void) enc_term_int(NULL, acmp, obj, ep, dflags, off_heap, NULL, &res);
+ return res;
+}
+
+static int
+enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
+ struct erl_off_heap_header** off_heap, Sint *reds, byte **res)
+{
+ DECLARE_ESTACK(s);
+ DECLARE_WSTACK(com);
Uint n;
Uint i;
Uint j;
Uint* ptr;
Eterm val;
FloatDef f;
-#if HALFWORD_HEAP
- UWord wobj;
-#endif
+ int count_reds = (p != NULL && reds != NULL);
+ Sint r = 0;
+
+ if (count_reds) {
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT);
+ WSTACK_CHANGE_ALLOCATOR(com, ERTS_ALC_T_EXTRA_ROOT);
+ r = *reds;
+ }
+ if (p && p->extra_root) { /* restore saved stacks and byte pointer */
+ ESTACK_RESTORE(s,p->extra_root[0].objv, p->extra_root[0].sz);
+ obj = ESTACK_POP(s);
+ WSTACK_RESTORE(com, p->extra_root[1].objv, p->extra_root[1].sz);
+ ep = (byte *) WSTACK_POP(com);
+ }
goto L_jump_start;
outer_loop:
- while (!WSTACK_ISEMPTY(s)) {
-#if HALFWORD_HEAP
- obj = (Eterm) (wobj = WSTACK_POP(s));
-#else
- obj = WSTACK_POP(s);
-#endif
- switch (val = WSTACK_POP(s)) {
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
+ switch (val = WSTACK_POP(com)) {
case ENC_TERM:
break;
case ENC_ONE_CONS:
@@ -1714,45 +2122,57 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
obj = CAR(cons);
tl = CDR(cons);
- WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM);
- WSTACK_PUSH(s, tl);
+ WSTACK_PUSH(com, is_list(tl) ? ENC_ONE_CONS : ENC_TERM);
+ ESTACK_PUSH(s, tl);
}
break;
case ENC_PATCH_FUN_SIZE:
+ /* obj will be discarded, it was NIL */
{
-#if HALFWORD_HEAP
- byte* size_p = (byte *) wobj;
-#else
- byte* size_p = (byte *) obj;
-#endif
+ byte* size_p = (byte *) WSTACK_POP(com);
put_int32(ep - size_p, size_p);
}
goto outer_loop;
case ENC_LAST_ARRAY_ELEMENT:
+ /* obj is the tuple */
{
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
- Eterm* ptr = (Eterm *) obj;
-#endif
- obj = *ptr;
+ Eterm* ptr = tuple_val(obj);
+ i = arityval(*ptr);
+ obj = ptr[i];
}
break;
default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */
{
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
- Eterm* ptr = (Eterm *) obj;
-#endif
- obj = *ptr++;
- WSTACK_PUSH(s, val-1);
- WSTACK_PUSH(s, (UWord) ptr);
+ Eterm* ptr = tuple_val(obj);
+ i = arityval(*ptr);
+ ESTACK_PUSH(s, obj); /* put back tuple and next element index */
+ WSTACK_PUSH(com, val-1);
+ obj = ptr[i - (val - ENC_LAST_ARRAY_ELEMENT)]; /* the index is counting down */
}
break;
}
L_jump_start:
+
+ if (count_reds && --r == 0) {
+ *reds = r;
+ ESTACK_PUSH(s,obj); /* push back current object, to be popped on restore */
+ WSTACK_PUSH(com,((UWord) ep));
+ if (p->extra_root == NULL) {
+ /* NB. Allocate an array of two "extra-roots", of which only the first element
+ is seen and handled by the GC. Index 1 holds the Wstack. */
+ p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)*2);
+ p->extra_root->objv = NULL;
+ p->extra_root->sz = 0;
+ p->extra_root->cleanup = cleanup_ttb_extra_root_2;
+ p->extra_root[1].objv = NULL;
+ p->extra_root[1].sz = 0;
+ p->extra_root[1].cleanup = NULL; /* Never used */
+ }
+ ESTACK_SAVE(s, p->extra_root[0].objv, p->extra_root[0].sz);
+ WSTACK_SAVE(com, p->extra_root[1].objv, (p->extra_root[1].sz));
+ return -1;
+ }
switch(tag_val_def(obj)) {
case NIL_DEF:
*ep++ = NIL_EXT;
@@ -1896,8 +2316,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
ep += 4;
}
if (i > 0) {
- WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1);
- WSTACK_PUSH(s, (UWord) ptr);
+ WSTACK_PUSH(com, ENC_LAST_ARRAY_ELEMENT+i-1);
+ ESTACK_PUSH(s, obj);
}
break;
@@ -2041,8 +2461,9 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
int ei;
*ep++ = NEW_FUN_EXT;
- WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE);
- WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */
+ WSTACK_PUSH(com, (UWord) ep); /* Position for patching in size */
+ WSTACK_PUSH(com, ENC_PATCH_FUN_SIZE);
+ ESTACK_PUSH(s,NIL); /* Will be thrown away */
ep += 4;
*ep = funp->arity;
ep += 1;
@@ -2059,8 +2480,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
fun_env:
for (ei = funp->num_free-1; ei > 0; ei--) {
- WSTACK_PUSH(s, ENC_TERM);
- WSTACK_PUSH(s, (UWord) funp->env[ei]);
+ WSTACK_PUSH(com, ENC_TERM);
+ ESTACK_PUSH(s, (UWord) funp->env[ei]);
}
if (funp->num_free != 0) {
obj = funp->env[0];
@@ -2103,8 +2524,17 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
break;
}
}
- DESTROY_WSTACK(s);
- return ep;
+ DESTROY_ESTACK(s);
+ DESTROY_WSTACK(com);
+ if (p && p->extra_root) {
+ cleanup_ttb_extra_root_2(p->extra_root);
+ p->extra_root = NULL;
+ }
+ if (count_reds) {
+ *reds = r;
+ }
+ *res = ep;
+ return 0;
}
static
@@ -2892,51 +3322,47 @@ dec_term_atom_common:
to a sequence of bytes
N.B. That this must agree with to_external2() above!!!
(except for cached atoms) */
+static Uint encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) {
+ Uint res;
+ (void) encode_size_struct_int(NULL, acmp, obj, dflags, NULL, &res);
+ return res;
+}
-static Uint
-encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
+static int
+encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj,
+ unsigned dflags, Sint *reds, Uint *res)
{
- DECLARE_WSTACK(s);
+ DECLARE_ESTACK(s);
Uint m, i, arity;
Uint result = 0;
-#if HALFWORD_HEAP
- UWord wobj = 0;
-#endif
+ int count_reds = (p != NULL && reds != 0);
+ Sint r = 0;
+
+ if (count_reds) {
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT);
+ r = *reds;
+ }
+
+ if (p && p->extra_root) { /* restore saved stack */
+ ESTACK_RESTORE(s,p->extra_root->objv, p->extra_root->sz + 1);
+ result = ESTACK_POP(s); /*Untagged, beyond p->extra_root->sz */
+ obj = ESTACK_POP(s);
+
+ }
goto L_jump_start;
outer_loop:
- while (!WSTACK_ISEMPTY(s)) {
-#if HALFWORD_HEAP
- obj = (Eterm) (wobj = WSTACK_POP(s));
-#else
- obj = WSTACK_POP(s);
-#endif
+ while (!ESTACK_ISEMPTY(s)) {
+ obj = ESTACK_POP(s);
handle_popped_obj:
- if (is_CP(obj)) { /* Does not look for CP, looks for "no tag" */
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
- Eterm* ptr = (Eterm *) obj;
-#endif
- /*
- * Pointer into a tuple.
- */
- obj = *ptr--;
- if (!is_header(obj)) {
- WSTACK_PUSH(s, (UWord)ptr);
- } else {
- /* Reached tuple header */
- ASSERT(header_is_arityval(obj));
- goto outer_loop;
- }
- } else if (is_list(obj)) {
+ if (is_list(obj)) {
Eterm* cons = list_val(obj);
Eterm tl;
tl = CDR(cons);
obj = CAR(cons);
- WSTACK_PUSH(s, tl);
+ ESTACK_PUSH(s, tl);
} else if (is_nil(obj)) {
result++;
goto outer_loop;
@@ -2948,6 +3374,20 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
}
L_jump_start:
+ if (count_reds && --r == 0) {
+ *reds = r;
+ ESTACK_PUSH(s,obj); /* push back current object */
+ ESTACK_PUSH(s,result); /* Untagged, will be out of GC reach */
+ if (p->extra_root == NULL) {
+ p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet));
+ p->extra_root->objv = NULL;
+ p->extra_root->sz = 0;
+ p->extra_root->cleanup = cleanup_ttb_extra_root;
+ }
+ ESTACK_SAVE(s, p->extra_root->objv, p->extra_root->sz);
+ --p->extra_root->sz; /* Hide result from GC */
+ return -1;
+ }
switch (tag_val_def(obj)) {
case NIL_DEF:
result++;
@@ -3034,20 +3474,24 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
case TUPLE_DEF:
{
Eterm* ptr = tuple_val(obj);
-
+ Uint i;
arity = arityval(*ptr);
if (arity <= 0xff) {
result += 1 + 1;
} else {
result += 1 + 4;
}
- ptr += arity;
-#if HALFWORD_HEAP
- obj = (Eterm) (wobj = (UWord) ptr);
-#else
- obj = (Eterm) ptr;
-#endif
- goto handle_popped_obj;
+ for (i = 1; i <= arity; ++i) {
+ if (is_list(ptr[i])) {
+ if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) {
+ result += m + 2 + 1;
+ } else {
+ result += 5;
+ }
+ }
+ ESTACK_PUSH(s,ptr[i]);
+ }
+ goto outer_loop;
}
break;
case FLOAT_DEF:
@@ -3105,14 +3549,14 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
if (is_not_list(obj)) {
/* Push any non-list terms on the stack */
- WSTACK_PUSH(s, obj);
+ ESTACK_PUSH(s, obj);
} else {
/* Lists must be handled specially. */
if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) {
result += m + 2 + 1;
} else {
result += 5;
- WSTACK_PUSH(s, obj);
+ ESTACK_PUSH(s, obj);
}
}
}
@@ -3143,8 +3587,16 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags)
}
}
- DESTROY_WSTACK(s);
- return result;
+ DESTROY_ESTACK(s);
+ if (p && p->extra_root) {
+ cleanup_ttb_extra_root(p->extra_root);
+ p->extra_root = NULL;
+ }
+ if (count_reds) {
+ *reds = r;
+ }
+ *res = result;
+ return 0;
}
static Sint
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 26ed5f82c1..25aedc91c6 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -376,7 +376,7 @@ extern int stackdump_on_exit;
*/
-void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end);
+void erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end);
#define ESTK_CONCAT(a,b) a##b
#define ESTK_SUBSCRIPT(s,i) *((Eterm *)((byte *)ESTK_CONCAT(s,_start) + (i)))
#define DEF_ESTACK_SIZE (16)
@@ -385,20 +385,79 @@ void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end);
Eterm ESTK_CONCAT(s,_default_stack)[DEF_ESTACK_SIZE]; \
Eterm* ESTK_CONCAT(s,_start) = ESTK_CONCAT(s,_default_stack); \
Eterm* ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start); \
- Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE
+ Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE;\
+ ErtsAlcType_t ESTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK
+
+#define ESTACK_CHANGE_ALLOCATOR(s,t) \
+do { \
+ if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \
+ erl_exit(1, "Internal error - trying to change allocator " \
+ "type of active estack\n"); \
+ } \
+ ESTK_CONCAT(s,_alloc_type) = (t); \
+ } while (0)
+
+/*
+ * Do not free the stack after this, it may have pointers into what
+ * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If
+ * 'v' points to anything, it should have been allocated by a previous
+ * call to this macro. Be careful to set a correct allocator prior to
+ * saving.
+ * 'v' can be any lvalue pointer, it will point to an array of UWord
+ * after calling this macro.
+ */
+#define ESTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \
+do { \
+ Uint _esz = ESTACK_COUNT(s); \
+ if (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) { \
+ if ((v) == NULL) { \
+ (v) = erts_alloc(ESTK_CONCAT(s,_alloc_type), \
+ DEF_ESTACK_SIZE * sizeof(Eterm)); \
+ } \
+ memcpy((v),ESTK_CONCAT(s,_start),_esz*sizeof(Eterm)); \
+ } else { \
+ (v) = (void *) ESTK_CONCAT(s,_start); \
+ } \
+ (vsize) = _esz; \
+ } while (0)
+
+/*
+ * Use on empty stack, only the allocator can be changed before this
+ * The vector parameter is reset to NULL if the vector is moved to stack,
+ * otherwise it's kept for reuse, so a saved and restored vector might
+ * need freeing using the correct allocator parameter.
+ * 'v' can be any lvalue pointer, it's cast to an (Eterm *).
+ */
+#define ESTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \
+do { \
+ if ((vsize) > DEF_ESTACK_SIZE) { \
+ Uint _ca = DEF_ESTACK_SIZE; \
+ while (_ca < (vsize)) \
+ _ca = _ca * 2; \
+ ESTK_CONCAT(s,_start) = (Eterm *) (v); \
+ ESTK_CONCAT(s,_end) = ((Eterm *)(v)) + _ca; \
+ ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \
+ (v) = NULL; \
+ } else { \
+ memcpy(ESTK_CONCAT(s,_start),(v),(vsize)*sizeof(Eterm));\
+ ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \
+ } \
+ } while (0)
+
+#define ESTACK_IS_STATIC(s) (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack))
#define DESTROY_ESTACK(s) \
do { \
if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \
- erts_free(ERTS_ALC_T_ESTACK, ESTK_CONCAT(s,_start)); \
+ erts_free(ESTK_CONCAT(s,_alloc_type), ESTK_CONCAT(s,_start)); \
} \
} while(0)
#define ESTACK_PUSH(s, x) \
do { \
if (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_end)) { \
- erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \
- &ESTK_CONCAT(s,_end)); \
+ erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \
+ &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \
} \
*ESTK_CONCAT(s,_sp)++ = (x); \
} while(0)
@@ -406,8 +465,8 @@ do { \
#define ESTACK_PUSH2(s, x, y) \
do { \
if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 2) { \
- erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \
- &ESTK_CONCAT(s,_end)); \
+ erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \
+ &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \
} \
*ESTK_CONCAT(s,_sp)++ = (x); \
*ESTK_CONCAT(s,_sp)++ = (y); \
@@ -430,7 +489,7 @@ do { \
#define ESTACK_POP(s) (*(--ESTK_CONCAT(s,_sp)))
-void erl_grow_wstack(UWord** start, UWord** sp, UWord** end);
+void erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end);
#define WSTK_CONCAT(a,b) a##b
#define WSTK_SUBSCRIPT(s,i) *((UWord *)((byte *)WSTK_CONCAT(s,_start) + (i)))
#define DEF_WSTACK_SIZE (16)
@@ -439,20 +498,79 @@ void erl_grow_wstack(UWord** start, UWord** sp, UWord** end);
UWord WSTK_CONCAT(s,_default_stack)[DEF_WSTACK_SIZE]; \
UWord* WSTK_CONCAT(s,_start) = WSTK_CONCAT(s,_default_stack); \
UWord* WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start); \
- UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE
+ UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE; \
+ ErtsAlcType_t WSTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK
+
+#define WSTACK_CHANGE_ALLOCATOR(s,t) \
+do { \
+ if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \
+ erl_exit(1, "Internal error - trying to change allocator " \
+ "type of active wstack\n"); \
+ } \
+ WSTK_CONCAT(s,_alloc_type) = (t); \
+ } while (0)
#define DESTROY_WSTACK(s) \
do { \
if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \
- erts_free(ERTS_ALC_T_ESTACK, WSTK_CONCAT(s,_start)); \
+ erts_free(WSTK_CONCAT(s,_alloc_type), WSTK_CONCAT(s,_start)); \
} \
} while(0)
+/*
+ * Do not free the stack after this, it may have pointers into what
+ * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If
+ * 'v' points to anything, it should have been allocated by a previous
+ * call to this macro. Be careful to set a correct allocator prior to
+ * saving.
+ * 'v' can be any lvalue pointer, it will point to an array of UWord
+ * after calling this macro.
+ */
+#define WSTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \
+do { \
+ Uint _wsz = WSTACK_COUNT(s); \
+ if (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) { \
+ if ((v) == NULL) { \
+ (v) = erts_alloc(WSTK_CONCAT(s,_alloc_type), \
+ DEF_WSTACK_SIZE * sizeof(UWord)); \
+ } \
+ memcpy((v),WSTK_CONCAT(s,_start),_wsz*sizeof(UWord)); \
+ } else { \
+ (v) = (void *) WSTK_CONCAT(s,_start); \
+ } \
+ (vsize) = _wsz; \
+ } while (0)
+
+/*
+ * Use on empty stack, only the allocator can be changed before this
+ * The vector parameter is reset to NULL if the vector is moved to stack,
+ * otherwise it's kept for reuse, so a saved and restored vector might
+ * need freeing using the correct allocator parameter.
+ * 'v' can be any lvalue pointer, it's cast to an (UWord *).
+ */
+#define WSTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \
+do { \
+ if ((vsize) > DEF_WSTACK_SIZE) { \
+ Uint _ca = DEF_WSTACK_SIZE; \
+ while (_ca < (vsize)) \
+ _ca = _ca * 2; \
+ WSTK_CONCAT(s,_start) = (UWord *) (v); \
+ WSTK_CONCAT(s,_end) = ((UWord *)(v)) + _ca; \
+ WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \
+ (v) = NULL; \
+ } else { \
+ memcpy(WSTK_CONCAT(s,_start),(v),(vsize)*sizeof(UWord));\
+ WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \
+ } \
+ } while (0)
+
+#define WSTACK_IS_STATIC(s) (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack))
+
#define WSTACK_PUSH(s, x) \
do { \
if (WSTK_CONCAT(s,_sp) == WSTK_CONCAT(s,_end)) { \
- erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \
- &WSTK_CONCAT(s,_end)); \
+ erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \
+ &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \
} \
*WSTK_CONCAT(s,_sp)++ = (x); \
} while(0)
@@ -460,8 +578,8 @@ do { \
#define WSTACK_PUSH2(s, x, y) \
do { \
if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 2) { \
- erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \
- &WSTK_CONCAT(s,_end)); \
+ erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \
+ &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \
} \
*WSTK_CONCAT(s,_sp)++ = (x); \
*WSTK_CONCAT(s,_sp)++ = (y); \
@@ -470,8 +588,8 @@ do { \
#define WSTACK_PUSH3(s, x, y, z) \
do { \
if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 3) { \
- erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \
- &WSTK_CONCAT(s,_end)); \
+ erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \
+ &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \
} \
*WSTK_CONCAT(s,_sp)++ = (x); \
*WSTK_CONCAT(s,_sp)++ = (y); \
@@ -723,10 +841,10 @@ void erts_raw_port_command(Port*, byte*, Uint);
void driver_report_exit(ErlDrvPort, int);
LineBuf* allocate_linebuf(int);
int async_ready(Port *, void*);
-ErtsPortNames *erts_get_port_names(Eterm);
+ErtsPortNames *erts_get_port_names(Eterm, ErlDrvPort);
void erts_free_port_names(ErtsPortNames *);
Uint erts_port_ioq_size(Port *pp);
-void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int);
+void erts_stale_drv_select(Eterm, ErlDrvPort, ErlDrvEvent, int, int);
Port *erts_get_heart_port(void);
@@ -740,6 +858,8 @@ void erl_drv_thr_init(void);
/* utils.c */
void erts_cleanup_offheap(ErlOffHeap *offheap);
+Uint64 erts_timestamp_millis(void);
+
Export* erts_find_function(Eterm, Eterm, unsigned int, ErtsCodeIndex);
Eterm store_external_or_ref_in_proc_(Process *, Eterm);
@@ -771,6 +891,9 @@ Sint erts_re_set_loop_limit(Sint limit);
void erts_init_bif_binary(void);
Sint erts_binary_set_loop_limit(Sint limit);
+/* external.c */
+void erts_init_external(void);
+
/* erl_unicode.c */
void erts_init_unicode(void);
Sint erts_unicode_set_loop_limit(Sint limit);
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 13cff24b95..c1e66b59af 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -4814,7 +4814,8 @@ int async_ready(Port *p, void* data)
static void
report_missing_drv_callback(Port *p, char *drv_type, char *callback)
{
- ErtsPortNames *pnp = erts_get_port_names(p->common.id);
+ ErtsPortNames *pnp = erts_get_port_names(p->common.id,
+ ERTS_Port2ErlDrvPort(p));
char *unknown = "<unknown>";
char *drv_name = pnp->driver_name ? pnp->driver_name : unknown;
char *prt_name = pnp->name ? pnp->name : unknown;
@@ -4829,15 +4830,25 @@ report_missing_drv_callback(Port *p, char *drv_type, char *callback)
void
erts_stale_drv_select(Eterm port,
+ ErlDrvPort drv_port,
ErlDrvEvent hndl,
int mode,
int deselect)
{
char *type;
- ErlDrvPort drv_port = ERTS_Port2ErlDrvPort(erts_port_lookup_raw(port));
- ErtsPortNames *pnp = erts_get_port_names(port);
+ ErtsPortNames *pnp;
erts_dsprintf_buf_t *dsbufp;
+ if (drv_port == ERTS_INVALID_ERL_DRV_PORT) {
+ Port *prt = erts_port_lookup_raw(port);
+ if (prt)
+ drv_port = ERTS_Port2ErlDrvPort(prt);
+ else
+ drv_port = ERTS_INVALID_ERL_DRV_PORT;
+ }
+
+ pnp = erts_get_port_names(port, drv_port);
+
switch (mode) {
case ERL_DRV_READ | ERL_DRV_WRITE:
type = "Input/Output";
@@ -4872,12 +4883,16 @@ erts_stale_drv_select(Eterm port,
}
ErtsPortNames *
-erts_get_port_names(Eterm id)
+erts_get_port_names(Eterm id, ErlDrvPort drv_port)
{
- Port *prt = erts_port_lookup_raw(id);
+ Port *prt;
ErtsPortNames *pnp;
ASSERT(is_nil(id) || is_internal_port(id));
+ prt = ERTS_ErlDrvPort2Port(drv_port);
+ if (prt == ERTS_INVALID_ERL_DRV_PORT)
+ prt = erts_port_lookup_raw(id);
+
if (!prt) {
pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, sizeof(ErtsPortNames));
pnp->name = NULL;
@@ -4889,6 +4904,7 @@ erts_get_port_names(Eterm id)
size_t pnp_len = sizeof(ErtsPortNames);
#ifndef DEBUG
pnp_len += 100; /* In most cases 100 characters will be enough... */
+ ASSERT(prt->common.id == id);
#endif
pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len);
do {
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index d5d97d748a..62caa67ce1 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -185,15 +185,15 @@ erts_set_hole_marker(Eterm* ptr, Uint sz)
* Helper function for the ESTACK macros defined in global.h.
*/
void
-erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end)
+erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end)
{
Uint old_size = (*end - *start);
Uint new_size = old_size * 2;
Uint sp_offs = *sp - *start;
if (new_size > 2 * DEF_ESTACK_SIZE) {
- *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(Eterm));
+ *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(Eterm));
} else {
- Eterm* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(Eterm));
+ Eterm* new_ptr = erts_alloc(a_type, new_size*sizeof(Eterm));
sys_memcpy(new_ptr, *start, old_size*sizeof(Eterm));
*start = new_ptr;
}
@@ -204,15 +204,15 @@ erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end)
* Helper function for the ESTACK macros defined in global.h.
*/
void
-erl_grow_wstack(UWord** start, UWord** sp, UWord** end)
+erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end)
{
Uint old_size = (*end - *start);
Uint new_size = old_size * 2;
Uint sp_offs = *sp - *start;
if (new_size > 2 * DEF_ESTACK_SIZE) {
- *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(UWord));
+ *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(UWord));
} else {
- UWord* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(UWord));
+ UWord* new_ptr = erts_alloc(a_type, new_size*sizeof(UWord));
sys_memcpy(new_ptr, *start, old_size*sizeof(UWord));
*start = new_ptr;
}
@@ -3722,6 +3722,24 @@ erts_smp_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
}
+/*
+ * A millisecond timestamp without time correction where there's no hrtime
+ * - for tracing on "long" things...
+ */
+Uint64 erts_timestamp_millis(void)
+{
+#ifdef HAVE_GETHRTIME
+ return (Uint64) (sys_gethrtime() / 1000000);
+#else
+ Uint64 res;
+ SysTimeval tv;
+ sys_gettimeofday(&tv);
+ res = (Uint64) tv.tv_sec*1000000;
+ res += (Uint64) tv.tv_usec;
+ return (res / 1000);
+#endif
+}
+
#ifdef DEBUG
/*
* Handy functions when using a debugger - don't use in the code!
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index 6cc1295973..595b0488a8 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -1679,10 +1679,10 @@ static void invoke_pwritev(void *data) {
d->again = 0;
}
} else
- ASSERT(written == FILE_SEGMENT_WRITE);
+ ASSERT(written >= FILE_SEGMENT_WRITE);
MUTEX_LOCK(d->c.writev.q_mtx);
- driver_deq(d->c.pwritev.port, size);
+ driver_deq(d->c.pwritev.port, written);
MUTEX_UNLOCK(d->c.writev.q_mtx);
done:
EF_FREE(iov); /* Free our copy of the vector, nothing to restore */
diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h
index bd85e43b8c..5387f75efc 100644
--- a/erts/emulator/drivers/common/erl_efile.h
+++ b/erts/emulator/drivers/common/erl_efile.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2013. 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
diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c
index 89b7be14f2..3fe5d282dc 100644
--- a/erts/emulator/drivers/common/zlib_drv.c
+++ b/erts/emulator/drivers/common/zlib_drv.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2003-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2003-2013. 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
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index 2bd5177be1..55539b44dd 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2013. 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
diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c
index 8b5e3eeefd..502cb58dfa 100644
--- a/erts/emulator/drivers/win32/ttsl_drv.c
+++ b/erts/emulator/drivers/win32/ttsl_drv.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2013. 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
diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c
index 1059fa5c3a..be3d86a1d2 100644
--- a/erts/emulator/drivers/win32/win_efile.c
+++ b/erts/emulator/drivers/win32/win_efile.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2013. 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
diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index 19fc448742..8f997aafab 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -2,7 +2,7 @@
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2001-2011. All Rights Reserved.
+ * Copyright Ericsson AB 2001-2013. 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
diff --git a/erts/emulator/internal_doc/dec.erl b/erts/emulator/internal_doc/dec.erl
index 255018abe0..bb69e6e81b 100644
--- a/erts/emulator/internal_doc/dec.erl
+++ b/erts/emulator/internal_doc/dec.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2013. 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
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 853dd90c34..7035dc77df 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -874,7 +874,7 @@ need2steal(ErtsDrvEventState *state, int mode)
static void
print_driver_name(erts_dsprintf_buf_t *dsbufp, Eterm id)
{
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
if (!pnp->name && !pnp->driver_name)
erts_dsprintf(dsbufp, "%s ", "<unknown>");
else {
@@ -1357,8 +1357,8 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
"Bad %s fd in erts_poll()! fd=%d, ",
io_str, (int) state->fd);
if (is_nil(port)) {
- ErtsPortNames *ipnp = erts_get_port_names(inport);
- ErtsPortNames *opnp = erts_get_port_names(outport);
+ ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT);
+ ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT);
erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n",
is_nil(inport) ? am_undefined : inport,
is_nil(outport) ? am_undefined : outport,
@@ -1370,7 +1370,7 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
erts_free_port_names(opnp);
}
else {
- ErtsPortNames *pnp = erts_get_port_names(port);
+ ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT);
erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n",
is_nil(port) ? am_undefined : port,
pnp->driver_name ? pnp->driver_name : "<unknown>",
@@ -1390,7 +1390,7 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
static void
stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode)
{
- erts_stale_drv_select(id, (ErlDrvEvent) state->fd, mode, 0);
+ erts_stale_drv_select(id, ERTS_INVALID_ERL_DRV_PORT, (ErlDrvEvent) state->fd, mode, 0);
deselect(state, mode);
}
@@ -1774,7 +1774,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
err = 1;
}
else {
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
erts_printf(" inport=%T inname=%s indrv=%s ",
id,
pnp->name ? pnp->name : "unknown",
@@ -1791,7 +1791,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
err = 1;
}
else {
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
erts_printf(" outport=%T outname=%s outdrv=%s ",
id,
pnp->name ? pnp->name : "unknown",
@@ -1827,7 +1827,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
err = 1;
}
else {
- ErtsPortNames *pnp = erts_get_port_names(id);
+ ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT);
erts_printf(" port=%T name=%s drv=%s ",
id,
pnp->name ? pnp->name : "unknown",
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index a523d67158..5861b30315 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2006-2012. All Rights Reserved.
+ * Copyright Ericsson AB 2006-2013. 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
@@ -40,6 +40,13 @@
# include "config.h"
#endif
+#if defined(__DARWIN__) || defined(__APPLE__) && defined(__MACH__)
+/* Setting _DARWIN_UNLIMITED_SELECT before including sys/select.h enables
+ * the version of select() that does not place a limit on the fd_set.
+ */
+# define _DARWIN_UNLIMITED_SELECT
+#endif
+
#ifndef WANT_NONBLOCKING
# define WANT_NONBLOCKING
#endif
@@ -90,6 +97,52 @@
#define HARD_DEBUG
#endif
+#ifdef _DARWIN_UNLIMITED_SELECT
+typedef struct {
+ size_t sz;
+ fd_set* ptr;
+}ERTS_fd_set;
+# define ERTS_FD_CLR(fd, fds) FD_CLR((fd), (fds)->ptr)
+# define ERTS_FD_SET(fd, fds) FD_SET((fd), (fds)->ptr)
+# define ERTS_FD_ISSET(fd,fds) FD_ISSET((fd), (fds)->ptr)
+# define ERTS_FD_ZERO(fds) memset((fds)->ptr, 0, (fds)->sz)
+# define ERTS_FD_SIZE(n) ((((n)+NFDBITS-1)/NFDBITS)*sizeof(fd_mask))
+
+static void ERTS_FD_COPY(ERTS_fd_set *src, ERTS_fd_set *dst)
+{
+ if (dst->sz != src->sz) {
+ dst->ptr = dst->ptr
+ ? erts_realloc(ERTS_ALC_T_SELECT_FDS, dst->ptr, src->sz)
+ : erts_alloc(ERTS_ALC_T_SELECT_FDS, src->sz);
+ dst->sz = src->sz;
+ }
+ memcpy(dst->ptr, src->ptr, src->sz);
+}
+
+static ERTS_INLINE
+int ERTS_SELECT(int nfds, ERTS_fd_set *readfds, ERTS_fd_set *writefds,
+ ERTS_fd_set *exceptfds, struct timeval *timeout)
+{
+ ASSERT(!readfds || readfds->sz >= nfds);
+ ASSERT(!writefds || writefds->sz >= nfds);
+ ASSERT(!exceptfds);
+ return select(nfds,
+ (readfds ? readfds->ptr : NULL ),
+ (writefds ? writefds->ptr : NULL),
+ NULL,
+ timeout);
+}
+
+#else /* !_DARWIN_UNLIMITED_SELECT */
+# define ERTS_fd_set fd_set
+# define ERTS_FD_CLR FD_CLR
+# define ERTS_FD_ISSET FD_ISSET
+# define ERTS_FD_SET FD_SET
+# define ERTS_FD_ZERO FD_ZERO
+# define ERTS_FD_COPY(src,dst) (*(dst) = *(src))
+# define ERTS_SELECT select
+#endif
+
#define ERTS_POLL_USE_BATCH_UPDATE_POLLSET (ERTS_POLL_USE_DEVPOLL \
|| ERTS_POLL_USE_KQUEUE)
#define ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE \
@@ -244,10 +297,10 @@ struct ErtsPollSet_ {
#if ERTS_POLL_USE_FALLBACK
int no_select_fds;
#endif
- fd_set input_fds;
- fd_set res_input_fds;
- fd_set output_fds;
- fd_set res_output_fds;
+ ERTS_fd_set input_fds;
+ ERTS_fd_set res_input_fds;
+ ERTS_fd_set output_fds;
+ ERTS_fd_set res_output_fds;
#endif
#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
ErtsPollSetUpdateRequestsBlock update_requests;
@@ -624,6 +677,33 @@ grow_poll_fds(ErtsPollSet ps, int min_ix)
}
#endif
+#ifdef _DARWIN_UNLIMITED_SELECT
+static void
+grow_select_fds(int fd, ERTS_fd_set* fds)
+{
+ int new_len = ERTS_POLL_EXPORT(erts_poll_get_table_len)(fd + 1);
+ if (new_len > max_fds)
+ new_len = max_fds;
+ new_len = ERTS_FD_SIZE(new_len);
+ fds->ptr = fds->sz
+ ? erts_realloc(ERTS_ALC_T_SELECT_FDS, fds->ptr, new_len)
+ : erts_alloc(ERTS_ALC_T_SELECT_FDS, new_len);
+ memset((char*)fds->ptr + fds->sz, 0, new_len - fds->sz);
+ fds->sz = new_len;
+}
+static ERTS_INLINE void
+ensure_select_fds(int fd, ERTS_fd_set* in, ERTS_fd_set* out)
+{
+ ASSERT(in->sz == out->sz);
+ if (ERTS_FD_SIZE(fd+1) > in->sz) {
+ grow_select_fds(fd, in);
+ grow_select_fds(fd, out);
+ }
+}
+#else
+# define ensure_select_fds(fd, in, out) do {} while(0)
+#endif /* _DARWIN_UNLIMITED_SELECT */
+
static void
grow_fds_status(ErtsPollSet ps, int min_fd)
{
@@ -1290,22 +1370,23 @@ static int update_pollset(ErtsPollSet ps, int fd)
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
{
ErtsPollEvents events = ps->fds_status[fd].events;
+ ensure_select_fds(fd, &ps->input_fds, &ps->output_fds);
if ((ERTS_POLL_EV_IN & events)
!= (ERTS_POLL_EV_IN & ps->fds_status[fd].used_events)) {
if (ERTS_POLL_EV_IN & events) {
- FD_SET(fd, &ps->input_fds);
+ ERTS_FD_SET(fd, &ps->input_fds);
}
else {
- FD_CLR(fd, &ps->input_fds);
+ ERTS_FD_CLR(fd, &ps->input_fds);
}
}
if ((ERTS_POLL_EV_OUT & events)
!= (ERTS_POLL_EV_OUT & ps->fds_status[fd].used_events)) {
if (ERTS_POLL_EV_OUT & events) {
- FD_SET(fd, &ps->output_fds);
+ ERTS_FD_SET(fd, &ps->output_fds);
}
else {
- FD_CLR(fd, &ps->output_fds);
+ ERTS_FD_CLR(fd, &ps->output_fds);
}
}
@@ -1789,7 +1870,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
while (fd < end_fd && res < max_res) {
pr[res].events = (ErtsPollEvents) 0;
- if (FD_ISSET(fd, &ps->res_input_fds)) {
+ if (ERTS_FD_ISSET(fd, &ps->res_input_fds)) {
#if ERTS_POLL_USE_FALLBACK
if (fd == ps->kp_fd) {
res += get_kp_results(ps, &pr[res], max_res-res);
@@ -1805,7 +1886,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
#endif
pr[res].events |= ERTS_POLL_EV_IN;
}
- if (FD_ISSET(fd, &ps->res_output_fds))
+ if (ERTS_FD_ISSET(fd, &ps->res_output_fds))
pr[res].events |= ERTS_POLL_EV_OUT;
if (pr[res].events) {
pr[res].fd = fd;
@@ -1832,24 +1913,23 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
while (fd < end_fd && res < max_res) {
if (ps->fds_status[fd].events) {
int sres;
- fd_set *iset = NULL;
- fd_set *oset = NULL;
+ ERTS_fd_set *iset = NULL;
+ ERTS_fd_set *oset = NULL;
if (ps->fds_status[fd].events & ERTS_POLL_EV_IN) {
iset = &ps->res_input_fds;
- FD_ZERO(iset);
- FD_SET(fd, iset);
+ ERTS_FD_ZERO(iset);
+ ERTS_FD_SET(fd, iset);
}
if (ps->fds_status[fd].events & ERTS_POLL_EV_OUT) {
oset = &ps->res_output_fds;
- FD_ZERO(oset);
- FD_SET(fd, oset);
-
+ ERTS_FD_ZERO(oset);
+ ERTS_FD_SET(fd, oset);
}
do {
/* Initiate 'tv' each time;
select() may modify it */
SysTimeval tv = {0, 0};
- sres = select(ps->max_fd+1, iset, oset, NULL, &tv);
+ sres = ERTS_SELECT(ps->max_fd+1, iset, oset, NULL, &tv);
} while (sres < 0 && errno == EINTR);
if (sres < 0) {
#if ERTS_POLL_USE_FALLBACK
@@ -1873,7 +1953,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
}
else if (sres > 0) {
pr[res].fd = fd;
- if (iset && FD_ISSET(fd, iset)) {
+ if (iset && ERTS_FD_ISSET(fd, iset)) {
#if ERTS_POLL_USE_FALLBACK
if (fd == ps->kp_fd) {
res += get_kp_results(ps,
@@ -1891,7 +1971,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res,
#endif
pr[res].events |= ERTS_POLL_EV_IN;
}
- if (oset && FD_ISSET(fd, oset)) {
+ if (oset && ERTS_FD_ISSET(fd, oset)) {
pr[res].events |= ERTS_POLL_EV_OUT;
}
ASSERT(pr[res].events);
@@ -1992,14 +2072,14 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res)
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
SysTimeval to = *tv;
- ps->res_input_fds = ps->input_fds;
- ps->res_output_fds = ps->output_fds;
-
+ ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds);
+ ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds);
+
#ifdef ERTS_SMP
if (to.tv_sec || to.tv_usec)
erts_thr_progress_prepare_wait(NULL);
#endif
- res = select(ps->max_fd + 1,
+ res = ERTS_SELECT(ps->max_fd + 1,
&ps->res_input_fds,
&ps->res_output_fds,
NULL,
@@ -2027,7 +2107,7 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res)
ERTS_POLLSET_LOCK(ps);
handle_update_requests(ps);
ERTS_POLLSET_UNLOCK(ps);
- res = select(ps->max_fd + 1,
+ res = ERTS_SELECT(ps->max_fd + 1,
&ps->res_input_fds,
&ps->res_output_fds,
NULL,
@@ -2233,7 +2313,8 @@ ERTS_POLL_EXPORT(erts_poll_init)(void)
max_fds = OPEN_MAX;
#endif
-#if ERTS_POLL_USE_SELECT && defined(FD_SETSIZE)
+#if ERTS_POLL_USE_SELECT && defined(FD_SETSIZE) && \
+ !defined(_DARWIN_UNLIMITED_SELECT)
if (max_fds > FD_SETSIZE)
max_fds = FD_SETSIZE;
#endif
@@ -2301,10 +2382,21 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void)
#if ERTS_POLL_USE_FALLBACK
ps->no_select_fds = 0;
#endif
- FD_ZERO(&ps->input_fds);
- FD_ZERO(&ps->res_input_fds);
- FD_ZERO(&ps->output_fds);
- FD_ZERO(&ps->res_output_fds);
+#ifdef _DARWIN_UNLIMITED_SELECT
+ ps->input_fds.sz = 0;
+ ps->input_fds.ptr = NULL;
+ ps->res_input_fds.sz = 0;
+ ps->res_input_fds.ptr = NULL;
+ ps->output_fds.sz = 0;
+ ps->output_fds.ptr = NULL;
+ ps->res_output_fds.sz = 0;
+ ps->res_output_fds.ptr = NULL;
+#else
+ ERTS_FD_ZERO(&ps->input_fds);
+ ERTS_FD_ZERO(&ps->res_input_fds);
+ ERTS_FD_ZERO(&ps->output_fds);
+ ERTS_FD_ZERO(&ps->res_output_fds);
+#endif
#endif
#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
ps->update_requests.next = NULL;
@@ -2382,6 +2474,16 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps)
if (ps->poll_fds)
erts_free(ERTS_ALC_T_POLL_FDS, (void *) ps->poll_fds);
#elif ERTS_POLL_USE_SELECT
+#ifdef _DARWIN_UNLIMITED_SELECT
+ if (ps->input_fds.ptr)
+ erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->input_fds.ptr);
+ if (ps->res_input_fds.ptr)
+ erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->res_input_fds.ptr);
+ if (ps->output_fds.ptr)
+ erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->output_fds.ptr);
+ if (ps->res_output_fds.ptr)
+ erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->res_output_fds.ptr);
+#endif
#endif
#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
{
@@ -2445,6 +2547,10 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip)
#if ERTS_POLL_USE_POLL
size += ps->poll_fds_len*sizeof(struct pollfd);
#elif ERTS_POLL_USE_SELECT
+#ifdef _DARWIN_UNLIMITED_SELECT
+ size += ps->input_fds.sz + ps->res_input_fds.sz
+ + ps->output_fds.sz + ps->res_output_fds.sz;
+#endif
#endif
#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE
diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c
index 2f2dfc8197..b84c8f85ce 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2011. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2013. 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
@@ -63,6 +63,8 @@
static SysHrTime wrap = 0;
static DWORD last_tick_count = 0;
+static erts_smp_mtx_t wrap_lock;
+static ULONGLONG (WINAPI *pGetTickCount64)(void) = NULL;
/* Getting timezone information is a heavy operation, so we want to do this
only once */
@@ -77,11 +79,23 @@ static int days_in_month[2][13] = {
int
sys_init_time(void)
{
+ char kernel_dll_name[] = "kernel32";
+ HMODULE module;
+
+ module = GetModuleHandle(kernel_dll_name);
+ pGetTickCount64 = (module != NULL) ?
+ (ULONGLONG (WINAPI *)(void))
+ GetProcAddress(module,"GetTickCount64") :
+ NULL;
+
if(GetTimeZoneInformation(&static_tzi) &&
static_tzi.StandardDate.wMonth != 0 &&
static_tzi.DaylightDate.wMonth != 0) {
have_static_tzi = 1;
}
+
+ erts_smp_mtx_init(&wrap_lock, "sys_gethrtime");
+
return 1;
}
@@ -363,15 +377,39 @@ sys_gettimeofday(SysTimeval *tv)
EPOCH_JULIAN_DIFF);
}
+extern int erts_initialized;
SysHrTime
sys_gethrtime(void)
{
- DWORD ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF);
- if (ticks < (SysHrTime) last_tick_count) {
- wrap += LL_LITERAL(1) << 31;
+ if (pGetTickCount64 != NULL) {
+ return ((SysHrTime) pGetTickCount64()) * LL_LITERAL(1000000);
+ } else {
+ DWORD ticks;
+ SysHrTime res;
+ erts_smp_mtx_lock(&wrap_lock);
+ ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF);
+ if (ticks < (SysHrTime) last_tick_count) {
+ /* Detect a race that should no longer be here... */
+ if ((((SysHrTime) last_tick_count) - ((SysHrTime) ticks)) > 1000) {
+ wrap += LL_LITERAL(1) << 31;
+ } else {
+ /*
+ * XXX Debug: Violates locking order, remove all this,
+ * after testing!
+ */
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ erts_dsprintf(dsbufp, "Did not wrap when last_tick %d "
+ "and tick %d",
+ last_tick_count, ticks);
+ erts_send_error_to_logger_nogl(dsbufp);
+ ticks = last_tick_count;
+ }
+ }
+ last_tick_count = ticks;
+ res = ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000));
+ erts_smp_mtx_unlock(&wrap_lock);
+ return res;
}
- last_tick_count = ticks;
- return ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000));
}
clock_t
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 33abd45982..801ed0f85a 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2013. 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
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index babdb3363f..fe0a745db8 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2013. 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
@@ -57,10 +57,10 @@
ordering/1,unaligned_order/1,gc_test/1,
bit_sized_binary_sizes/1,
otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
- otp_8180/1]).
+ otp_8180/1, ttb_trap/1]).
%% Internal exports.
--export([sleeper/0]).
+-export([sleeper/0,ttb_loop/2]).
suite() -> [{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,2}}].
@@ -75,7 +75,7 @@ all() ->
bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
ordering, unaligned_order, gc_test,
bit_sized_binary_sizes, otp_6817, otp_8117, deep,
- obsolete_funs, robustness, otp_8180].
+ obsolete_funs, robustness, otp_8180, ttb_trap].
groups() ->
[].
@@ -1322,6 +1322,38 @@ run_otp_8180(Name) ->
end || Bin <- Bins],
ok.
+%% Test that exit and GC during term_to_binary trap does not crash.
+ttb_trap(Config) when is_list(Config)->
+ case erlang:system_info(wordsize) of
+ N when N < 8 ->
+ {skipped, "Only on 64bit machines"};
+ _ ->
+ do_ttb_trap(5)
+ end.
+
+do_ttb_trap(0) ->
+ ok;
+do_ttb_trap(N) ->
+ Pid = spawn(?MODULE,ttb_loop,[1000,self()]),
+ receive ok -> ok end,
+ receive after 100 -> ok end,
+ erlang:garbage_collect(Pid),
+ receive after 100 -> ok end,
+ exit(Pid,kill),
+ receive after 1 -> ok end,
+ do_ttb_trap(N-1).
+
+ttb_loop(N,Pid) ->
+ Term = lists:duplicate(2000000,2000000),
+ Pid ! ok,
+ ttb_loop2(N,Term).
+ttb_loop2(0,_T) ->
+ ok;
+ttb_loop2(N,T) ->
+ apply(erlang,term_to_binary,[T]),
+ ttb_loop2(N-1,T).
+
+
%% Utilities.
make_sub_binary(Bin) when is_binary(Bin) ->
diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl
index d2c80c1ca0..1cfe015ea6 100644
--- a/erts/emulator/test/code_parallel_load_SUITE.erl
+++ b/erts/emulator/test/code_parallel_load_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2013. 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
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 13aa0f4c00..fcd4457c34 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2013. 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
@@ -92,7 +92,7 @@
spawn_driver/1, spawn_executable/1, close_deaf_port/1,
unregister_name/1, parallelism_option/1]).
--export([]).
+-export([do_iter_max_ports/2]).
%% Internal exports.
-export([tps/3]).
@@ -628,16 +628,23 @@ iter_max_ports(Config) when is_list(Config) ->
iter_max_ports_test(Config) ->
- Dog = test_server:timetrap(test_server:minutes(20)),
+ Dog = test_server:timetrap(test_server:minutes(30)),
PortTest = port_test(Config),
Command = lists:concat([PortTest, " -h0 -q"]),
Iters = case os:type() of
{win32,_} -> 4;
_ -> 10
end,
- L = do_iter_max_ports(Iters, Command),
+ %% Run on a different node in order to limit the effect if this test fails.
+ Dir = filename:dirname(code:which(?MODULE)),
+ {ok,Node} = test_server:start_node(test_iter_max_socks,slave,
+ [{args,"+Q 2048 -pa " ++ Dir}]),
+ L = rpc:call(Node,?MODULE,do_iter_max_ports,[Iters, Command]),
+ test_server:stop_node(Node),
+
io:format("Result: ~p",[L]),
all_equal(L),
+ all_equal(L),
test_server:timetrap_cancel(Dog),
{comment, "Max ports: " ++ integer_to_list(hd(L))}.
@@ -670,7 +677,7 @@ close_ports([]) ->
ok.
open_ports(Name, Settings) ->
- test_server:sleep(50),
+ test_server:sleep(5),
case catch open_port(Name, Settings) of
P when is_port(P) ->
[P| open_ports(Name, Settings)];
diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl
index 6615873392..b631f55a03 100644
--- a/erts/emulator/test/send_term_SUITE.erl
+++ b/erts/emulator/test/send_term_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2013. 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
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 221b65309a..0f513f0dcb 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2013. 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
@@ -34,6 +34,7 @@
system_monitor_args/1, more_system_monitor_args/1,
system_monitor_long_gc_1/1, system_monitor_long_gc_2/1,
system_monitor_large_heap_1/1, system_monitor_large_heap_2/1,
+ system_monitor_long_schedule/1,
bad_flag/1, trace_delivered/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -52,6 +53,7 @@ all() ->
set_on_first_spawn, system_monitor_args,
more_system_monitor_args, system_monitor_long_gc_1,
system_monitor_long_gc_2, system_monitor_large_heap_1,
+ system_monitor_long_schedule,
system_monitor_large_heap_2, bad_flag, trace_delivered].
groups() ->
@@ -508,6 +510,65 @@ try_l(Val) ->
?line {Self,Comb1} = erlang:system_monitor(undefined),
?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1).
+monitor_sys(Parent) ->
+ receive
+ {monitor,Pid,long_schedule,Data} when is_pid(Pid) ->
+ io:format("Long schedule of ~w: ~w~n",[Pid,Data]),
+ Parent ! {Pid,Data},
+ monitor_sys(Parent);
+ {monitor,Port,long_schedule,Data} when is_port(Port) ->
+ {name,Name} = erlang:port_info(Port,name),
+ io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]),
+ Parent ! {Port,Data},
+ monitor_sys(Parent);
+ Other ->
+ erlang:display(Other)
+ end.
+
+start_monitor() ->
+ Parent = self(),
+ Mpid = spawn_link(fun() -> monitor_sys(Parent) end),
+ erlang:system_monitor(Mpid,[{long_schedule,100}]),
+ erlang:yield(), % Need to be rescheduled for the trace to take
+ ok.
+
+system_monitor_long_schedule(suite) ->
+ [];
+system_monitor_long_schedule(doc) ->
+ ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"];
+system_monitor_long_schedule(Config) when is_list(Config) ->
+ Path = ?config(data_dir, Config),
+ erl_ddll:start(),
+ case (catch load_driver(Path, slow_drv)) of
+ ok ->
+ do_system_monitor_long_schedule();
+ _Error ->
+ {skip, "Unable to load slow_drv (windows or no usleep()?)"}
+ end.
+do_system_monitor_long_schedule() ->
+ start_monitor(),
+ Port = open_port({spawn_driver,slow_drv}, []),
+ "ok" = erlang:port_control(Port,0,[]),
+ Self = self(),
+ receive
+ {Self,L} when is_list(L) ->
+ ok
+ after 1000 ->
+ ?t:fail(no_trace_of_pid)
+ end,
+ "ok" = erlang:port_control(Port,1,[]),
+ "ok" = erlang:port_control(Port,2,[]),
+ receive
+ {Port,LL} when is_list(LL) ->
+ ok
+ after 1000 ->
+ ?t:fail(no_trace_of_port)
+ end,
+ port_close(Port),
+ erlang:system_monitor(undefined),
+ ok.
+
+
-define(LONG_GC_SLEEP, 670).
system_monitor_long_gc_1(suite) ->
@@ -1521,3 +1582,11 @@ issue_non_empty_runq_warning(DeadLine, RQLen) ->
" Processes info: ~p~n",
[DeadLine div 1000, RQLen, self(), PIs]),
receive after 1000 -> ok end.
+
+load_driver(Dir, Driver) ->
+ case erl_ddll:load_driver(Dir, Driver) of
+ ok -> ok;
+ {error, Error} = Res ->
+ io:format("~s\n", [erl_ddll:format_error(Error)]),
+ Res
+ end.