aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/beam')
-rw-r--r--erts/emulator/beam/atom.names1
-rw-r--r--erts/emulator/beam/beam_bp.c2
-rw-r--r--erts/emulator/beam/big.c2
-rw-r--r--erts/emulator/beam/break.c2
-rw-r--r--erts/emulator/beam/erl_alloc.c22
-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.c190
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.h13
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c6
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.h2
-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.c2
-rw-r--r--erts/emulator/beam/erl_node_tables.c2
-rw-r--r--erts/emulator/beam/erl_port_task.h2
-rw-r--r--erts/emulator/beam/erl_process.c92
-rw-r--r--erts/emulator/beam/erl_process.h17
-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.c2
-rw-r--r--erts/emulator/beam/erl_trace.h2
-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.h153
-rw-r--r--erts/emulator/beam/io.c2
-rw-r--r--erts/emulator/beam/utils.c12
32 files changed, 1095 insertions, 210 deletions
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 3ee9eb0f88..eba1d0fa23 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -534,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/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 a547191d6d..5eacff8829 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -240,15 +240,21 @@ 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)
{
ip->thr_spec = 1;
ip->atype = AOFIRSTFIT;
- ip->init.aoff.bf_within_carrier = 1;
+ ip->init.aoff.flavor = AOFF_BF;
ip->init.util.acul = acul;
}
+#endif
+
static void
set_default_sl_alloc_opts(struct au_init *ip)
{
@@ -558,7 +564,7 @@ static ERTS_INLINE int
strategy_support_carrier_migration(struct au_init *auip)
{
/*
- * Currently only aoff and aoffcaobf support carrier
+ * Currently only aoff, aoffcbf and aoffcaobf support carrier
* migration, i.e, type AOFIRSTFIT.
*/
return auip->atype == AOFIRSTFIT;
@@ -581,9 +587,9 @@ ensure_carrier_migration_support(struct au_init *auip)
* default to a strategy that can...
*/
if (!strategy_support_carrier_migration(auip)) {
- /* Default to aoffcaobf */
+ /* Default to aoffcbf */
auip->atype = AOFIRSTFIT;
- auip->init.aoff.bf_within_carrier = 1;
+ auip->init.aoff.flavor = AOFF_BF;
}
}
@@ -1284,11 +1290,15 @@ handle_au_arg(struct au_init *auip,
}
else if (strcmp("aoff", alg) == 0) {
auip->atype = AOFIRSTFIT;
- auip->init.aoff.bf_within_carrier = 0;
+ auip->init.aoff.flavor = AOFF_AOFF;
+ }
+ else if (strcmp("aoffcbf", alg) == 0) {
+ auip->atype = AOFIRSTFIT;
+ auip->init.aoff.flavor = AOFF_BF;
}
else if (strcmp("aoffcaobf", alg) == 0) {
auip->atype = AOFIRSTFIT;
- auip->init.aoff.bf_within_carrier = 1;
+ auip->init.aoff.flavor = AOFF_AOBF;
}
else {
bad_value(param, sub_param + 1, alg);
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.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index f73ac2eb6e..4e6c8b317e 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -34,10 +34,11 @@
* sub-tree ('max_sz'). By that we can start from root and keep
* left (for low addresses) while dismissing entire sub-trees with
* too small blocks.
- * AOFFCBF:
+ * Bestfit within carrier:
* The only difference for "bestfit within carrier" is the tree
* sorting order. Blocks within the same carrier are sorted
- * wrt size instead of address.
+ * wrt size instead of address. The 'max_sz' field is maintained
+ * in order to dismiss entire carriers with too small blocks.
*
* Authors: Rickard Green/Sverker Eriksson
*/
@@ -67,6 +68,15 @@
# define LEFT_VISITED_FLG (((Uint) 1) << 2)
# define RIGHT_VISITED_FLG (((Uint) 1) << 3)
#endif
+#ifdef DEBUG
+# define IS_BF_FLG (((Uint) 1) << 4)
+#endif
+
+#define IS_TREE_NODE(N) (((AOFF_RBTree_t *) (N))->flags & TREE_NODE_FLG)
+#define IS_LIST_ELEM(N) (!IS_TREE_NODE(((AOFF_RBTree_t *) (N))))
+
+#define SET_TREE_NODE(N) (((AOFF_RBTree_t *) (N))->flags |= TREE_NODE_FLG)
+#define SET_LIST_ELEM(N) (((AOFF_RBTree_t *) (N))->flags &= ~TREE_NODE_FLG)
#define IS_RED(N) (((AOFF_RBTree_t *) (N)) \
&& ((AOFF_RBTree_t *) (N))->flags & RED_FLG)
@@ -98,6 +108,16 @@ struct AOFF_RBTree_t_ {
};
#define AOFF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr)
+/* BF block nodes keeps list of all with equal size
+ */
+typedef struct {
+ AOFF_RBTree_t t;
+ AOFF_RBTree_t *next;
+}AOFF_RBTreeList_t;
+
+#define LIST_NEXT(N) (((AOFF_RBTreeList_t*) (N))->next)
+#define LIST_PREV(N) (((AOFF_RBTreeList_t*) (N))->t.parent)
+
typedef struct AOFF_Carrier_t_ AOFF_Carrier_t;
struct AOFF_Carrier_t_ {
@@ -119,11 +139,11 @@ struct AOFF_Carrier_t_ {
#ifdef HARD_DEBUG
# define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE)
-# define HARD_CHECK_TREE(CRR,BF,ROOT,SZ) check_tree(CRR, BF, ROOT, SZ)
-static AOFF_RBTree_t * check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint);
+# define HARD_CHECK_TREE(CRR,FLV,ROOT,SZ) check_tree(CRR, FLV, ROOT, SZ)
+static AOFF_RBTree_t * check_tree(Carrier_t* within_crr, enum AOFF_Flavor flavor, AOFF_RBTree_t* root, Uint);
#else
# define HARD_CHECK_IS_MEMBER(ROOT,NODE)
-# define HARD_CHECK_TREE(CRR,BF,ROOT,SZ)
+# define HARD_CHECK_TREE(CRR,FLV,ROOT,SZ)
#endif
@@ -161,25 +181,25 @@ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node,
else ASSERT(new_max == old_max);
}
-static ERTS_INLINE SWord cmp_blocks(int bestfit,
+static ERTS_INLINE SWord cmp_blocks(enum AOFF_Flavor flavor,
AOFF_RBTree_t* lhs, AOFF_RBTree_t* rhs)
{
ASSERT(lhs != rhs);
- ASSERT(!bestfit || FBLK_TO_MBC(&lhs->hdr) == FBLK_TO_MBC(&rhs->hdr));
- if (bestfit) {
+ ASSERT(flavor == AOFF_AOFF || FBLK_TO_MBC(&lhs->hdr) == FBLK_TO_MBC(&rhs->hdr));
+ if (flavor != AOFF_AOFF) {
SWord diff = (SWord)AOFF_BLK_SZ(lhs) - (SWord)AOFF_BLK_SZ(rhs);
- if (diff) return diff;
+ if (diff || flavor == AOFF_BF) return diff;
}
return (char*)lhs - (char*)rhs;
}
-static ERTS_INLINE SWord cmp_cand_blk(int bestfit,
+static ERTS_INLINE SWord cmp_cand_blk(enum AOFF_Flavor flavor,
Block_t* cand_blk, AOFF_RBTree_t* rhs)
{
- if (bestfit) {
+ if (flavor != AOFF_AOFF) {
if (BLK_TO_MBC(cand_blk) == FBLK_TO_MBC(&rhs->hdr)) {
SWord diff = (SWord)MBC_BLK_SZ(cand_blk) - (SWord)MBC_FBLK_SZ(&rhs->hdr);
- if (diff) return diff;
+ if (diff || flavor == AOFF_BF) return diff;
}
}
return (char*)cand_blk - (char*)rhs;
@@ -198,7 +218,7 @@ static UWord aoff_largest_fblk_in_mbc(Allctr_t*, Carrier_t*);
/* Generic tree functions used by both carrier and block trees. */
static void rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del);
-static void rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk);
+static void rbt_insert(enum AOFF_Flavor flavor, AOFF_RBTree_t** root, AOFF_RBTree_t* blk);
static AOFF_RBTree_t* rbt_search(AOFF_RBTree_t* root, Uint size);
#ifdef HARD_DEBUG
static int rbt_assert_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node);
@@ -234,21 +254,21 @@ erts_aoffalc_start(AOFFAllctr_t *alc,
sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t));
- alc->bf_within_carrier = aoffinit->bf_within_carrier;
+ alc->flavor = aoffinit->flavor;
allctr->mbc_header_size = sizeof(AOFF_Carrier_t);
allctr->min_mbc_size = MIN_MBC_SZ;
allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ;
- allctr->min_block_size = sizeof(AOFF_RBTree_t);
+ allctr->min_block_size = (aoffinit->flavor == AOFF_BF ?
+ sizeof(AOFF_RBTreeList_t):sizeof(AOFF_RBTree_t));
- allctr->vsn_str = aoffinit->bf_within_carrier ?
- ERTS_ALC_AOFF_CBF_ALLOC_VSN_STR : ERTS_ALC_AOFF_ALLOC_VSN_STR;
+ allctr->vsn_str = ERTS_ALC_AOFF_ALLOC_VSN_STR;
/* Callback functions */
allctr->get_free_block = aoff_get_free_block;
allctr->link_free_block = aoff_link_free_block;
- allctr->unlink_free_block = aoff_unlink_free_block;
+ allctr->unlink_free_block = aoff_unlink_free_block;
allctr->info_options = info_options;
allctr->get_next_mbc_size = NULL;
@@ -359,9 +379,7 @@ replace(AOFF_RBTree_t **root, AOFF_RBTree_t *x, AOFF_RBTree_t *y)
y->parent = x->parent;
y->right = x->right;
y->left = x->left;
-
- y->max_sz = x->max_sz;
- lower_max_size(y, NULL);
+ y->max_sz = x->max_sz;
}
static void
@@ -458,23 +476,47 @@ tree_insert_fixup(AOFF_RBTree_t** root, AOFF_RBTree_t *blk)
}
static void
-aoff_unlink_free_block(Allctr_t *allctr, Block_t *del)
+aoff_unlink_free_block(Allctr_t *allctr, Block_t *blk)
{
-#ifdef HARD_DEBUG
AOFFAllctr_t* alc = (AOFFAllctr_t*)allctr;
-#endif
- AOFF_Carrier_t *crr = (AOFF_Carrier_t*) FBLK_TO_MBC(del);
+ AOFF_RBTree_t* del = (AOFF_RBTree_t*)blk;
+ AOFF_Carrier_t *crr = (AOFF_Carrier_t*) FBLK_TO_MBC(&del->hdr);
ASSERT(crr->rbt_node.hdr.bhdr == crr->root->max_sz);
- HARD_CHECK_IS_MEMBER(alc->mbc_root, &crr->rbt_node);
- HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, 0);
+ HARD_CHECK_TREE(&crr->crr, alc->flavor, crr->root, 0);
+
+ if (alc->flavor == AOFF_BF) {
+ ASSERT(del->flags & IS_BF_FLG);
+ if (IS_LIST_ELEM(del)) {
+ /* Remove from list */
+ ASSERT(LIST_PREV(del));
+ ASSERT(LIST_PREV(del)->flags & IS_BF_FLG);
+ LIST_NEXT(LIST_PREV(del)) = LIST_NEXT(del);
+ if (LIST_NEXT(del)) {
+ ASSERT(LIST_NEXT(del)->flags & IS_BF_FLG);
+ LIST_PREV(LIST_NEXT(del)) = LIST_PREV(del);
+ }
+ return;
+ }
+ else if (LIST_NEXT(del)) {
+ /* Replace tree node by next element in list... */
+
+ ASSERT(AOFF_BLK_SZ(LIST_NEXT(del)) == AOFF_BLK_SZ(del));
+ ASSERT(IS_LIST_ELEM(LIST_NEXT(del)));
+
+ replace(&crr->root, (AOFF_RBTree_t*)del, LIST_NEXT(del));
+
+ HARD_CHECK_TREE(&crr->crr, alc->flavor, crr->root, 0);
+ return;
+ }
+ }
rbt_delete(&crr->root, (AOFF_RBTree_t*)del);
- HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, 0);
+ HARD_CHECK_TREE(&crr->crr, alc->flavor, crr->root, 0);
- /* Update the carrier tree with a potentially new (lower) max_sz
- */
+ /* Update the carrier tree with a potentially new (lower) max_sz
+ */
if (crr->root) {
if (crr->rbt_node.hdr.bhdr == crr->root->max_sz) {
return;
@@ -488,6 +530,7 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *del)
lower_max_size(&crr->rbt_node, NULL);
}
+
static void
rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del)
{
@@ -542,7 +585,9 @@ rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del)
}
if (y != z) {
/* We spliced out the successor of z; replace z by the successor */
+ ASSERT(z != &null_x);
replace(root, z, y);
+ lower_max_size(y, NULL);
}
if (spliced_is_black) {
@@ -666,12 +711,11 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block)
ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(&blk_crr->crr));
ASSERT(blk_crr->rbt_node.hdr.bhdr == (blk_crr->root ? blk_crr->root->max_sz : 0));
- HARD_CHECK_IS_MEMBER(alc->mbc_root, &blk_crr->rbt_node);
- HARD_CHECK_TREE(&blk_crr->crr, alc->bf_within_carrier, blk_crr->root, 0);
+ HARD_CHECK_TREE(&blk_crr->crr, alc->flavor, blk_crr->root, 0);
- rbt_insert(alc->bf_within_carrier, &blk_crr->root, blk);
+ rbt_insert(alc->flavor, &blk_crr->root, blk);
- /* Update the carrier tree with a potential new (larger) max_sz
+ /* Update the carrier tree with a potentially new (larger) max_sz
*/
crr_node = &blk_crr->rbt_node;
if (blk_sz > crr_node->hdr.bhdr) {
@@ -683,15 +727,19 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block)
if (!crr_node) break;
}
}
- HARD_CHECK_TREE(&blk_crr->crr, alc->bf_within_carrier, blk_crr->root, 0);
+ HARD_CHECK_TREE(&blk_crr->crr, alc->flavor, blk_crr->root, 0);
}
static void
-rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
+rbt_insert(enum AOFF_Flavor flavor, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
{
Uint blk_sz = AOFF_BLK_SZ(blk);
- blk->flags = 0;
+#ifdef DEBUG
+ blk->flags = (flavor == AOFF_BF) ? IS_BF_FLG : 0;
+#else
+ blk->flags = 0;
+#endif
blk->left = NULL;
blk->right = NULL;
blk->max_sz = blk_sz;
@@ -704,10 +752,12 @@ rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
else {
AOFF_RBTree_t *x = *root;
while (1) {
+ SWord diff;
if (x->max_sz < blk_sz) {
x->max_sz = blk_sz;
}
- if (cmp_blocks(bestfit, blk, x) < 0) {
+ diff = cmp_blocks(flavor, blk, x);
+ if (diff < 0) {
if (!x->left) {
blk->parent = x;
x->left = blk;
@@ -715,7 +765,7 @@ rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
}
x = x->left;
}
- else {
+ else if (diff > 0) {
if (!x->right) {
blk->parent = x;
x->right = blk;
@@ -723,6 +773,18 @@ rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
}
x = x->right;
}
+ else {
+ ASSERT(flavor == AOFF_BF);
+ ASSERT(blk->flags & IS_BF_FLG);
+ ASSERT(x->flags & IS_BF_FLG);
+ SET_LIST_ELEM(blk);
+ LIST_NEXT(blk) = LIST_NEXT(x);
+ LIST_PREV(blk) = x;
+ if (LIST_NEXT(x))
+ LIST_PREV(LIST_NEXT(x)) = blk;
+ LIST_NEXT(x) = blk;
+ return;
+ }
}
/* Insert block into size tree */
@@ -732,6 +794,10 @@ rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
if (IS_RED(blk->parent))
tree_insert_fixup(root, blk);
}
+ if (flavor == AOFF_BF) {
+ SET_TREE_NODE(blk);
+ LIST_NEXT(blk) = NULL;
+ }
}
static AOFF_RBTree_t*
@@ -780,7 +846,7 @@ aoff_get_free_block(Allctr_t *allctr, Uint size,
/* Get block within carrier tree
*/
#ifdef HARD_DEBUG
- dbg_blk = HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, size);
+ dbg_blk = HARD_CHECK_TREE(&crr->crr, alc->flavor, crr->root, size);
#endif
blk = rbt_search(crr->root, size);
@@ -793,7 +859,7 @@ aoff_get_free_block(Allctr_t *allctr, Uint size,
if (!blk)
return NULL;
- if (cand_blk && cmp_cand_blk(alc->bf_within_carrier, cand_blk, blk) < 0) {
+ if (cand_blk && cmp_cand_blk(alc->flavor, cand_blk, blk) < 0) {
return NULL; /* cand_blk was better */
}
@@ -813,7 +879,7 @@ static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier)
/* Link carrier in address order tree
*/
crr->rbt_node.hdr.bhdr = 0;
- rbt_insert(0, root, &crr->rbt_node);
+ rbt_insert(AOFF_AOFF, root, &crr->rbt_node);
/* aoff_link_free_block will add free block later */
crr->root = NULL;
@@ -843,7 +909,7 @@ static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
/* Link carrier in address order tree
*/
- rbt_insert(0, root, &crr->rbt_node);
+ rbt_insert(AOFF_AOFF, root, &crr->rbt_node);
HARD_CHECK_TREE(NULL, 0, *root, 0);
}
@@ -883,6 +949,7 @@ static struct {
Eterm as;
Eterm aoff;
Eterm aoffcaobf;
+ Eterm aoffcbf;
#ifdef DEBUG
Eterm end_of_atoms;
#endif
@@ -912,6 +979,7 @@ init_atoms(void)
AM_INIT(as);
AM_INIT(aoff);
AM_INIT(aoffcaobf);
+ AM_INIT(aoffcbf);
#ifdef DEBUG
for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) {
@@ -943,13 +1011,15 @@ info_options(Allctr_t *allctr,
{
AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr;
Eterm res = THE_NON_VALUE;
+ const char* flavor_str[3] = {"aoff", "aoffcaobf", "aoffcbf"};
+ Eterm flavor_atom[3] = {am.aoff, am.aoffcaobf, am.aoffcbf};
if (print_to_p) {
erts_print(*print_to_p,
print_to_arg,
"%sas: %s\n",
prefix,
- alc->bf_within_carrier ? "aoffcaobf" : "aoff");
+ flavor_str[alc->flavor]);
}
if (hpp || szp) {
@@ -959,8 +1029,7 @@ info_options(Allctr_t *allctr,
__FILE__, __LINE__);;
res = NIL;
- add_2tup(hpp, szp, &res, am.as,
- alc->bf_within_carrier ? am.aoffcaobf : am.aoff);
+ add_2tup(hpp, szp, &res, am.as, flavor_atom[alc->flavor]);
}
return res;
@@ -978,6 +1047,7 @@ UWord
erts_aoffalc_test(UWord op, UWord a1, UWord a2)
{
switch (op) {
+ case 0x500: return (UWord) ((AOFFAllctr_t *) a1)->flavor == AOFF_AOBF;
case 0x501: {
AOFF_RBTree_t *node = ((AOFFAllctr_t *) a1)->mbc_root;
Uint size = (Uint) a2;
@@ -987,10 +1057,13 @@ erts_aoffalc_test(UWord op, UWord a1, UWord a2)
case 0x502: return (UWord) ((AOFF_RBTree_t *) a1)->parent;
case 0x503: return (UWord) ((AOFF_RBTree_t *) a1)->left;
case 0x504: return (UWord) ((AOFF_RBTree_t *) a1)->right;
+ case 0x505: return (UWord) LIST_NEXT(a1);
case 0x506: return (UWord) IS_BLACK((AOFF_RBTree_t *) a1);
+ case 0x507: return (UWord) IS_TREE_NODE((AOFF_RBTree_t *) a1);
case 0x508: return (UWord) 0; /* IS_BF_ALGO */
case 0x509: return (UWord) ((AOFF_RBTree_t *) a1)->max_sz;
- case 0x50a: return (UWord) ((AOFFAllctr_t *) a1)->bf_within_carrier;
+ case 0x50a: return (UWord) ((AOFFAllctr_t *) a1)->flavor == AOFF_BF;
+ case 0x50b: return (UWord) LIST_PREV(a1);
default: ASSERT(0); return ~((UWord) 0);
}
}
@@ -1049,7 +1122,7 @@ static void print_tree(AOFF_RBTree_t*);
*/
static AOFF_RBTree_t *
-check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size)
+check_tree(Carrier_t* within_crr, enum AOFF_Flavor flavor, AOFF_RBTree_t* root, Uint size)
{
AOFF_RBTree_t *res = NULL;
Sint blacks;
@@ -1061,6 +1134,7 @@ check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size)
#ifdef PRINT_TREE
print_tree(root);
#endif
+ ASSERT(within_crr || flavor == AOFF_AOFF);
if (!root)
return res;
@@ -1116,6 +1190,20 @@ check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size)
ASSERT(crr == within_crr);
ASSERT((char*)x > (char*)crr);
ASSERT(((char*)x + AOFF_BLK_SZ(x)) <= ((char*)crr + CARRIER_SZ(crr)));
+
+ }
+ if (flavor == AOFF_BF) {
+ AOFF_RBTree_t* y = x;
+ AOFF_RBTree_t* nxt = LIST_NEXT(y);
+ ASSERT(IS_TREE_NODE(x));
+ while (nxt) {
+ ASSERT(IS_LIST_ELEM(nxt));
+ ASSERT(AOFF_BLK_SZ(nxt) == AOFF_BLK_SZ(x));
+ ASSERT(FBLK_TO_MBC(&nxt->hdr) == within_crr);
+ ASSERT(LIST_PREV(nxt) == y);
+ y = nxt;
+ nxt = LIST_NEXT(nxt);
+ }
}
if (IS_RED(x)) {
@@ -1127,13 +1215,13 @@ check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size)
if (x->left) {
ASSERT(x->left->parent == x);
- ASSERT(cmp_blocks(bestfit, x->left, x) < 0);
+ ASSERT(cmp_blocks(flavor, x->left, x) < 0);
ASSERT(x->left->max_sz <= x->max_sz);
}
if (x->right) {
ASSERT(x->right->parent == x);
- ASSERT(cmp_blocks(bestfit, x->right, x) > 0);
+ ASSERT(cmp_blocks(flavor, x->right, x) > 0);
ASSERT(x->right->max_sz <= x->max_sz);
}
ASSERT(x->max_sz >= AOFF_BLK_SZ(x));
@@ -1142,7 +1230,7 @@ check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size)
|| x->max_sz == (x->right ? x->right->max_sz : 0));
if (size && AOFF_BLK_SZ(x) >= size) {
- if (!res || cmp_blocks(bestfit, x, res) < 0) {
+ if (!res || cmp_blocks(flavor, x, res) < 0) {
res = x;
}
}
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h
index 87427e8e62..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
@@ -24,12 +24,17 @@
#include "erl_alloc_util.h"
#define ERTS_ALC_AOFF_ALLOC_VSN_STR "0.9"
-#define ERTS_ALC_AOFF_CBF_ALLOC_VSN_STR "0.9"
typedef struct AOFFAllctr_t_ AOFFAllctr_t;
+enum AOFF_Flavor {
+ AOFF_AOFF = 0,
+ AOFF_AOBF = 1,
+ AOFF_BF = 2
+};
+
typedef struct {
- int bf_within_carrier;
+ enum AOFF_Flavor flavor;
} AOFFAllctrInit_t;
#define ERTS_DEFAULT_AOFF_ALLCTR_INIT {0/*dummy*/}
@@ -52,7 +57,7 @@ struct AOFFAllctr_t_ {
Allctr_t allctr; /* Has to be first! */
struct AOFF_RBTree_t_* mbc_root;
- int bf_within_carrier;
+ enum AOFF_Flavor flavor;
};
UWord erts_aoffalc_test(UWord, UWord, UWord);
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index 58e53c3d00..41f449bb28 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -966,15 +966,17 @@ UWord
erts_bfalc_test(UWord op, UWord a1, UWord a2)
{
switch (op) {
- case 0x200: return (UWord) ((BFAllctr_t *) a1)->address_order;
+ case 0x200: return (UWord) ((BFAllctr_t *) a1)->address_order; /* IS_AOBF */
case 0x201: return (UWord) ((BFAllctr_t *) a1)->mbc_root;
case 0x202: return (UWord) ((RBTree_t *) a1)->parent;
case 0x203: return (UWord) ((RBTree_t *) a1)->left;
case 0x204: return (UWord) ((RBTree_t *) a1)->right;
- case 0x205: return (UWord) ((RBTreeList_t *) a1)->next;
+ case 0x205: return (UWord) LIST_NEXT(a1);
case 0x206: return (UWord) IS_BLACK((RBTree_t *) a1);
case 0x207: return (UWord) IS_TREE_NODE((RBTree_t *) a1);
case 0x208: return (UWord) 1; /* IS_BF_ALGO */
+ case 0x20a: return (UWord) !((BFAllctr_t *) a1)->address_order; /* IS_BF */
+ case 0x20b: return (UWord) LIST_PREV(a1);
default: ASSERT(0); return ~((UWord) 0);
}
}
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_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 2ac5e24d3a..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
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.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 3d161f2aa0..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
@@ -2045,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);
+ }
}
}
@@ -2062,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);
+ }
}
}
@@ -2666,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)
{
@@ -4332,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
@@ -5755,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)
@@ -7513,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;
@@ -8945,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 3c1edfad7a..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;
@@ -1976,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 bb6ed44523..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
diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 54d3aafdda..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
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 12eb3bfb7c..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); \
@@ -773,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 01e130bd64..c1e66b59af 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -4842,7 +4842,7 @@ erts_stale_drv_select(Eterm port,
if (drv_port == ERTS_INVALID_ERL_DRV_PORT) {
Port *prt = erts_port_lookup_raw(port);
if (prt)
- drv_port = ERTS_Port2ErlDrvPort(port);
+ drv_port = ERTS_Port2ErlDrvPort(prt);
else
drv_port = ERTS_INVALID_ERL_DRV_PORT;
}
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 0a833f7e66..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;
}