Make all steps ofterm_to_binary work in chunks and yield

Rewrite and extend of Happi's initial work

Extra_root to process structure to enable GC of state - Changed the
process structure to point to a separate struct, the struct also
contains a destructor function to allow for proper cleanup.

Rewrote encode_size_struct and enc_term to have internal versions with
reduction counters which will result in interrupt for later restart
when the counter reaches zero - removed the EWA_STACK from Happis
version and directly save the ESTACK's and WSTACK's in the above
mentioned struct (or array thereof) that are pointed out from the
process structure. The destructor will take care of the deallocation
in case of process death.

Added ESTACK and WSTACK macros to save and restore stack and to change
allocator, which makes the previously mentioned stack-save work.

Rewrote enc_term to not store pointers on the stack, and use one WSTACK
for commands etc and another ESTACK for Eterms - Slightly different than
Happis version to make halfword code simpler.

Rewrote encode_size_struct2 so that it does not store pointers on the
stack, also switched to ESTACK instead of WSTACK, this also handles
halfword correctly.

Added interfaces for chunkwise compression, that are
used from term_to_binary/2 when the compressed option is given.

12 files changed, 824 insertions, 458 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index bf1480ea06..267bcf5209 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -197,7 +197,6 @@ atom elib_malloc
 atom emulator
 atom enable_trace
 atom enabled
-atom enc_term_cont
 atom endian
 atom env
 atom eof
@@ -531,7 +530,7 @@ atom system_version
 atom system_architecture
 atom SYSTEM='SYSTEM'
 atom table
-atom term_to_binary_of_size
+atom term_to_binary_trap
 atom this
 atom thread_pool_size
 atom threads
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index a7b3d4cb2f..44f4eb9d43 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -1740,10 +1740,10 @@ dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy)
     /* Encode internal version of dist header */
     obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp);
     /* Encode control message */
-    erts_encode_dist_ext(c_p, ctl, &obuf->ext_endp, flags, acmp);
+    erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp);
     if (is_value(msg)) {
 	/* Encode message */
-       erts_encode_dist_ext(c_p, msg, &obuf->ext_endp, flags, acmp);
+	erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp);
     }
 
     ASSERT(obuf->extp < obuf->ext_endp);
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 095ad24387..99ba31e8e5 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
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 2c219ee87c..da0f46e556 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1964,15 +1964,20 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
         ++n;
     }
 
-    // Check if a suspended bif has live working data.
-    // How do we know n is small enough to fit in roots[32?]?
+    /*
+     * A trapping BIF can add to rootset by setting the extra_root
+     * in the process_structure.
+     */
     if (p->extra_root != NULL) {
-      printf("GC with extra_root 0x%xl\n", p->extra_root);
-        roots[n].v = p->extra_root;
-        roots[n].sz = p->extra_root_sz;
-        ++n;
+#ifdef HARDDEBUG
+	erts_fprintf(stderr,"GC with extra root 0x%xl\n", p->extra_root->objv);
+#endif
+	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)));
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 7724033245..783a529747 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -7512,10 +7512,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->extra_root_sz = 0;
-    p->extra_root_allocator = 0;
 
     p->bin_vheap_sz     = p->min_vheap_size;
     p->bin_old_vheap_sz = p->min_vheap_size;
@@ -8948,6 +8945,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 fca83dba8f..56cefc9e7d 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -699,6 +699,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,10 +800,7 @@ struct process {
 
     ErlMessageQueue msg;	/* Message queue */
 
-    Eterm *extra_root;          /* Extra root set, used e.g. by yielding bifs. */
-    Uint extra_root_sz;         /* Size of extra root set. */
-    ErtsAlcType_t extra_root_allocator; /* Type of memory allocator used,
-                                used for freeing extra_root if process dies. */
+    ErlExtraRootSet *extra_root;   /* Used by trapping BIF's */
 
     union {
 	ErtsBifTimer *bif_timers;	/* Bif timers aiming at this process */
@@ -1980,6 +1985,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_zlib.c b/erts/emulator/beam/erl_zlib.c
index f73d48b6c2..c8f29a7ce4 100644
--- a/erts/emulator/beam/erl_zlib.c
+++ b/erts/emulator/beam/erl_zlib.c
@@ -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..eb2e14f585 100644
--- a/erts/emulator/beam/erl_zlib.h
+++ b/erts/emulator/beam/erl_zlib.h
@@ -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 c90074528c..9e86442f32 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -81,52 +81,11 @@
  *
  */
 
-
-typedef struct {
-  UWord *start;
-  Eterm *sp;
-  UWord *end;
-  UWord *wsp;
-
-  ErtsAtomCacheMap *acmp;
-  Eterm obj;
-  byte *bytes, *ep;
-  Uint32 dflags;
-  struct erl_off_heap_header** off_heap;
-} enc_work_area;
-
-#define PRINT_EWA(ewa)                                      \
-do {                                                        \
-  Uint *_msp = ewa->start;                                  \
-  printf("start: 0x%lx\n\r", (Uint)ewa->start);              \
-  printf("sp: 0x%lx\n\r",  (Uint)ewa->sp);                   \
-  printf("end: 0x%lx\n\r",  (Uint)ewa->end);                 \
-  printf("wsp: 0x%lx\n\r",  (Uint)ewa->wsp);                 \
-  printf("acmp: 0x%lx\n\r",  (Uint)ewa->acmp);               \
-  printf("obj: 0x%lx\n\r",  (Uint)ewa->obj);                 \
-  printf("ep: 0x%lx\n\r",  (Uint)ewa->ep);                   \
-  printf("bytes: 0x%lx\n\r",  (Uint)ewa->bytes);             \
-  printf("dflags: %d\n\r",  (int)ewa->dflags);             \
-  printf("off_heap: 0x%lx\n\r",  (Uint)ewa->off_heap);       \
-  printf("Estack:");                                        \
-  while(_msp < ewa->sp) printf("0x%lx ",(long int)*_msp++); \
-  _msp = ewa->end-1;                                        \
-  printf("\n\rWstack:");                                    \
-  while(_msp > ewa->wsp) printf("%d ",(int)*_msp--);        \
-  printf("\n\r\n\n");                                       \
-} while(0)
-
 static Export term_to_binary_trap_export;
-static Export enc_term_trap_export;
 
-static BIF_RETTYPE term_to_binary_of_size_2(BIF_ALIST_2);
-static BIF_RETTYPE enc_term_trap_3(BIF_ALIST_3);
-static BIF_RETTYPE term_to_binary_of_size(Process *, Eterm, Eterm);
-static BIF_RETTYPE enc_term_cont(Process *, Eterm);
-static BIF_RETTYPE enc_term_trap(Process *, Eterm, Eterm, Eterm);
 static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap);
-static Eterm erl_enc_term(Process *, ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap, Eterm args, byte* bytes, Eterm bin);
-static byte* enc_small(Eterm, byte*);
+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);
@@ -134,19 +93,32 @@ 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) {
-  erts_init_trap_export(&term_to_binary_trap_export,
-                        am_erlang, am_term_to_binary_of_size, 2,
-                        &term_to_binary_of_size_2);
-  erts_init_trap_export(&enc_term_trap_export,
-                        am_erlang, am_enc_term_cont, 3,
-                        &enc_term_trap_3);
+#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;
 }
 
-static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned);
-
 #define ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES 255
 
 #define ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTE_IX(IIX) \
@@ -552,15 +524,18 @@ Uint erts_encode_ext_size_ets(Eterm term)
 }
 
 
-void erts_encode_dist_ext(Process *p, Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp)
+void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp)
 {
     byte *ep = *ext;
 #ifndef ERTS_DEBUG_USE_DIST_SEP
     if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
 #endif
 	*ep++ = VERSION_MAGIC;
-    // TODO: handle process arg and scheduling
     ep = enc_term(acmp, term, ep, flags, NULL);
+    if (!ep)
+	erl_exit(ERTS_ABORT_EXIT,
+		 "%s:%d:erts_encode_dist_ext(): Internal data structure error\n",
+		 __FILE__, __LINE__);
     *ext = ep;
 }
 
@@ -568,17 +543,16 @@ void erts_encode_ext(Eterm term, byte **ext)
 {
     byte *ep = *ext;
     *ep++ = VERSION_MAGIC;
-    // TODO: get process pointer from all uses of erts_encode_ext,
-    //       and make them handle yielding.
     ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS, NULL);
+    if (!ep)
+	erl_exit(ERTS_ABORT_EXIT,
+		 "%s:%d:erts_encode_ext(): Internal data structure error\n",
+		 __FILE__, __LINE__);
     *ext = ep;
 }
 
 byte* erts_encode_ext_ets(Eterm term, byte *ep, struct erl_off_heap_header** off_heap)
 {
-    // TODO: get process pointer from all uses of erts_encode_ext_ets,
-    //       and make them handle yielding.
-
     return enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS|DFLAG_INTERNAL_TAGS,
 		    off_heap);
 }
@@ -1061,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)
@@ -1074,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));
@@ -1110,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)
@@ -1387,87 +1386,34 @@ 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 options, *hp;
-
-    /* Save C-level options in an Erlang over trap. */
-    size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */;
-    hp = HAlloc(p, 4); /* Size of a 3-tuple */
-    options = TUPLE3(hp, make_small(level), make_small(flags), make_small(size));
-
-    BUMP_REDS(p, (size >> 8));
-    if (p->fcalls < 1) {
-      BIF_TRAP2(&term_to_binary_trap_export, p, Term, options);
-    }
-
-    return term_to_binary_of_size(p, Term, options);
-}
-
-BIF_RETTYPE term_to_binary_of_size_2(BIF_ALIST_2)
-{
-  return term_to_binary_of_size(BIF_P, BIF_ARG_1, BIF_ARG_2);
-}
-
-
-static BIF_RETTYPE term_to_binary_of_size(Process *p, Eterm arg1, Eterm arg2)
-{
-    Uint size;
-    Uint32 flags;
-    Eterm bin, *ptr;
-    byte* bytes;
-
-    ptr = tuple_val(arg2);
-    flags = unsigned_val(ptr[2]);
-    size = unsigned_val(ptr[3]);
-
-    bin = new_binary(p, (byte *)NULL, size);
-    bytes = binary_bytes(bin);
-    bytes[0] = VERSION_MAGIC;
-    return erl_enc_term(p, NULL, arg1, bytes+1, flags, NULL, arg2, bytes, bin);
-}
-
-static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm bin)
-{
-    Eterm *ptr;
+    Eterm bin;
     size_t real_size;
-    byte *bytes, *endp, *ep;
-    int level;
-    Uint size;
-    enc_work_area *ewa;
-    Binary *bin2;
-
-
-    bin2 = ((ProcBin *) binary_val(res))->val;
-    ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin2));
-    ep = ewa->ep;
-    bytes = ewa->bytes;
-    if (!ep)
-        erl_exit(ERTS_ABORT_EXIT,
-		 "%s:%d:enc_term: Internal data structure error\n",
-		 __FILE__, __LINE__);
-
-    ptr = tuple_val(args);
-    level = signed_val(ptr[1]);
-    size = unsigned_val(ptr[3]);
-
-    bin2 = ((ProcBin *) binary_val(res))->val;
-    ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin2));
-    endp = ewa->ep;
-
-    real_size = endp - bytes;
-    if (real_size > size) {
-      erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
-               __FILE__, __LINE__, endp - (bytes + size));
-    }
+    byte* endp;
 
     if (level != 0) {
+	byte buf[256];
+	byte* bytes = buf;
 	byte* out_bytes;
 	uLongf dest_len;
 
+	if (sizeof(buf) < size) {
+	    bytes = erts_alloc(ERTS_ALC_T_TMP, size);
+	}
+
+	if ((endp = enc_term(NULL, Term, bytes, flags, NULL))
+	    == NULL) {
+	    erl_exit(1, "%s, line %d: bad term: %x\n",
+		     __FILE__, __LINE__, Term);
+	}
+	real_size = endp - bytes;
+	if (real_size > size) {
+	    erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
+		     __FILE__, __LINE__, real_size - size);
+	}
+
 	/*
 	 * We don't want to compress if compression actually increases the size.
 	 * Therefore, don't give zlib more out buffer than the size of the
@@ -1481,7 +1427,7 @@ static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm
 	} else {
 	    dest_len = real_size - 5;
 	}
-	bin = erts_realloc_binary(bin, real_size+1);
+	bin = new_binary(p, NULL, real_size+1);
 	out_bytes = binary_bytes(bin);
 	out_bytes[0] = VERSION_MAGIC;
 	if (erl_zlib_compress2(out_bytes+6, &dest_len, bytes, real_size, level) != Z_OK) {
@@ -1492,45 +1438,338 @@ static BIF_RETTYPE term_to_binary_cont(Process *p, Eterm res, Eterm args, Eterm
 	    put_int32(real_size, out_bytes+2);
 	    bin = erts_realloc_binary(bin, dest_len+6);
 	}
-
+	if (bytes != buf) {
+	    erts_free(ERTS_ALC_T_TMP, bytes);
+	}
+	return bin;
     } else {
-        bin = erts_realloc_binary(bin, real_size);
+	byte* bytes;
+
+	bin = new_binary(p, (byte *)NULL, size);
+	bytes = binary_bytes(bin);
+	bytes[0] = VERSION_MAGIC;
+	if ((endp = enc_term(NULL, Term, bytes+1, flags, NULL))
+	    == NULL) {
+	    erl_exit(1, "%s, line %d: bad term: %x\n",
+		     __FILE__, __LINE__, Term);
+	}
+	real_size = endp - bytes;
+	if (real_size > size) {
+	    erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
+		     __FILE__, __LINE__, endp - (bytes + size));
+	}
+	return erts_realloc_binary(bin, real_size);
     }
-    return bin;
 }
 
+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);
+}
 
-static byte*
-enc_small(Eterm obj, byte *ep)
+#define EXTREME_TTB_TRAPPING 1
+
+#ifndef EXTREME_TTB_TRAPPING
+#define TERM_TO_BINARY_LOOP_FACTOR 10
+#define TERM_TO_BINARY_SIZE_FACTOR 10000
+#define TERM_TO_BINARY_COMPRESS_CHUNK 10000
+#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) 
 {
-    Uint n;
-    Sint val = signed_val(obj);
-
-    if ((Uint)val < 256) {
-        *ep++ = SMALL_INTEGER_EXT;
-        put_int8(val, ep);
-        ep++;
-    } else if (sizeof(Sint) == 4 || IS_SSMALL32(val)) {
-        *ep++ = INTEGER_EXT;
-        put_int32(val, ep);
-        ep += 4;
+    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; /* XXX */
+#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 {
-        DeclareTmpHeapNoproc(tmp_big,2);
-        Eterm big;
-        UseTmpHeapNoproc(2);
-        big = small_to_big(val, tmp_big);
-        *ep++ = SMALL_BIG_EXT;
-        n = big_bytes(big);
-        ASSERT(n < 256);
-        put_int8(n, ep);
-        ep += 1;
-        *ep++ = big_sign(big);
-        ep = big_to_bytes(big, ep);
-        UnUseTmpHeapNoproc(2);
+	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);
+		    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();
+		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);
+			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);
+		    return make_binary(pb);
+		}
+	    }
+	}
     }
+#undef EXPORT_CONTEXT
+#undef RETURN_STATE
+}			
+
+
+
+
+
 
-    return ep;
-}
 
 
 /*
@@ -1795,244 +2034,134 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete
 #define ENC_TERM ((Eterm) 0)
 #define ENC_ONE_CONS ((Eterm) 1)
 #define ENC_PATCH_FUN_SIZE ((Eterm) 2)
+#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3)
 
-/* While doing term_to_binary we keep two stacks.
-   One stack contains erlang terms to handle, this stack is passed to the GC
-   as a root set through process.extra_rootset.
-   The other stack contains "work orders" (integers (0, 1, or 2)), this stack
-   the GC can't handle.
-   Both stacks are stored in one memory area which can be reallocated and
-   deallocated if the process dies during a yield.
- */
-#define ALLOC_EWASTACK(ewa)                                             \
-    ewa->start = (Eterm *)erts_alloc(ERTS_ALC_T_ESTACK, DEF_WSTACK_SIZE*sizeof(UWord)*2); \
-    ewa->sp = ewa->start;                                               \
-    ewa->end = ewa->start + DEF_WSTACK_SIZE*2;                          \
-    ewa->wsp = ewa->end - 1;
-
-
-#define DESTROY_EWASTACK(ewa)						\
-do {									\
-	if(ewa->start != NULL) {					\
-	  erts_free(ERTS_ALC_T_ESTACK, ewa->start);			\
-	  ewa->start=NULL;						\
-        }								\
-} while(0)
-
-#define GROW_IF_NEEDED(ewa)                                             \
-    if (ewa->sp == ewa->wsp) {                  			\
-        int size = (ewa->end - ewa->wsp) -1;				\
-	erl_grow_wstack(&ewa->start, &ewa->sp, &ewa->end);		\
-        ewa->wsp = ewa->end-1;                                          \
-        while(size) *ewa->wsp-- = ewa->sp[size--];			\
-    }									
-
-#define EWASTACK_PUSH(ewa, x)						\
-do {									\
-       GROW_IF_NEEDED(ewa)		         			\
-       *ewa->sp++ = (x);						\
-} while(0)
-
-#define EWASTACK_WPUSH(ewa, x)						\
-do {									\
-    GROW_IF_NEEDED(ewa)                                                 \
-    *ewa->wsp-- = (x);	                 				\
-} while(0)
-
-#define EWASTACK_COUNT(ewa) (ewa->sp - ewa->start)
-#define EWASTACK_WCOUNT(ewa) (ewa->end - ewa->wsp)
-#define EWASTACK_WISEMPTY(ewa) (ewa->wsp == (ewa->end-1))
-#define EWASTACK_POP(ewa) (*(--ewa->sp))
-#define EWASTACK_WPOP(ewa) (*(++ewa->wsp))
-
-#define SAVE_TO_EWA                                                     \
-do {									\
-    ewa->acmp = acmp;                                                   \
-    ewa->obj = obj;                                                     \
-    ewa->ep = ep;                                                       \
-    ewa->dflags = dflags;						\
-    ewa->off_heap = off_heap;						\
-} while(0)
-
-#define GET_FROM_EWA                                                    \
-do {									\
-    acmp = ewa->acmp;                                                   \
-    obj = ewa->obj;                                                     \
-    ep = ewa->ep;                                                       \
-    dflags = ewa->dflags;                                               \
-    off_heap = ewa->off_heap;                                           \
-} while(0)
-
-
-static void cleanup_my_data_ttb(Binary *bp)
-{
-    enc_work_area *ewa;
-    ewa = (enc_work_area *)ERTS_MAGIC_BIN_DATA(bp);
-    DESTROY_EWASTACK(ewa);
-    return;
-}
-
-
-
-#define SET_UP_EWA \
-    bin =  erts_create_magic_binary(sizeof(enc_work_area), cleanup_my_data_ttb); \
-    ewa = (enc_work_area *)ERTS_MAGIC_BIN_DATA(bin); \
-    ALLOC_EWASTACK(ewa);\
-    SAVE_TO_EWA;
-
-#define CHECK_ENC_TERM()                                                \
-    if (!ep)                                                            \
-        erl_exit(ERTS_ABORT_EXIT,                                       \
-		 "%s:%d:enc_term: Internal data structure error\n",     \
-		 __FILE__, __LINE__);
-
-
-/* Yielding entry point to enc_term. */
-Eterm
-erl_enc_term(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
-             struct erl_off_heap_header** off_heap, Eterm args, byte* bytes, Eterm resbin)
+/* Free extra rootset (used when trapping) */
+static void cleanup_ttb_extra_root(ErlExtraRootSet *rs)
 {
-    Eterm *hp, mbin, res;
-    enc_work_area *ewa;
-    Binary *bin;
-    SET_UP_EWA;
-    ewa->bytes = bytes;
-
-    hp = HAlloc(p, PROC_BIN_SIZE);
-    mbin = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
-
-    res = enc_term_cont(p, mbin);
-    if(res == THE_NON_VALUE) {
-        // Yield
-        p->extra_root = ewa->start;
-        p->extra_root_sz = (Uint) EWASTACK_COUNT(ewa);
-        p->extra_root_allocator = ERTS_ALC_T_ESTACK;
-        BIF_TRAP3(&enc_term_trap_export, p, mbin, args, resbin);
+    if (rs->objv != NULL) {
+	erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv);
     }
-
-    return term_to_binary_cont(p, res, args, resbin);
-}
-
-BIF_RETTYPE enc_term_trap_3(BIF_ALIST_3)
-{
-   return enc_term_trap(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+    erts_free(ERTS_ALC_T_EXTRA_ROOT, rs);
 }
 
-BIF_RETTYPE enc_term_trap(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+/* 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)
 {
-    Eterm res;
-    res = enc_term_cont(p, arg1);
-    if(res == THE_NON_VALUE) {
-        // Yield
-        BIF_TRAP3(&enc_term_trap_export, p, arg1, arg2, arg3);
+    if (rs->objv != NULL) {
+	erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv);
     }
-
-    return term_to_binary_cont(p, res, arg2, arg3);
+    if (rs[1].objv != NULL) {
+	erts_free(ERTS_ALC_T_EXTRA_ROOT, rs[1].objv);
+    }
+	
+    erts_free(ERTS_ALC_T_EXTRA_ROOT, rs);
 }
 
-/* Non-yielding entry point to enc_term */
 static byte*
 enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
 	 struct erl_off_heap_header** off_heap)
 {
-    Eterm *buf, *start_buf, mbin, res;
-    ErlOffHeap fake_off_heap;
-    enc_work_area *ewa;
-    Binary *bin;
-    SET_UP_EWA;
-    start_buf = buf = (Eterm *) erts_alloc(ERTS_ALC_T_BINARY_BUFFER, PROC_BIN_SIZE);
-    fake_off_heap.first=NULL;
-    mbin = erts_mk_magic_binary_term(&buf, &fake_off_heap, bin);
-    res = enc_term_cont(NULL, mbin);
-    bin = ((ProcBin *) binary_val(res))->val;
-    ewa = ((enc_work_area *)ERTS_MAGIC_BIN_DATA(bin));
-    ep = ewa->ep;
-    CHECK_ENC_TERM();
-    erts_free(ERTS_ALC_T_BINARY_BUFFER, start_buf);
-    return ep;
+    byte *res;
+    (void) enc_term_int(NULL, acmp, obj, ep, dflags, off_heap, NULL, &res);
+    return res;
 }
 
-
-BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
+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
-    enc_work_area *ewa;
-    ErtsAtomCacheMap *acmp;
-    Eterm obj;
-    byte* ep;
-    Uint32 dflags;
-    struct erl_off_heap_header** off_heap;
+    int count_reds = (p != NULL && reds != NULL);
+    Sint r = 0;
 
-    int reds;
-    Binary *bin = ((ProcBin *) binary_val(arg1))->val;
-    ewa = (enc_work_area *) ERTS_MAGIC_BIN_DATA(bin);
-    GET_FROM_EWA;
+    if (count_reds) {
+	ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT);
+	WSTACK_CHANGE_ALLOCATOR(com, ERTS_ALC_T_EXTRA_ROOT);
+	r = *reds;
+    }
 
-    /* TODO: We could store the old values in ewa and restore them here... */
-    if(p != NULL) {
-      p->extra_root = NULL;
-      p->extra_root_sz = 0;
+    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);
     }
-    reds = (p == NULL) ? 0 : p->fcalls;
-    if (EWASTACK_WISEMPTY(ewa)) goto L_jump_start;
-    else goto outer_loop;
 
- outer_loop:
-    while (!EWASTACK_WISEMPTY(ewa)) {
-        if ((p != NULL) && (--reds < 1)) {
-          p->fcalls = reds;
-          SAVE_TO_EWA;
-          p->extra_root = ewa->start;
-          p->extra_root_sz = (Uint) EWASTACK_COUNT(ewa);
-          p->extra_root_allocator = ERTS_ALC_T_ESTACK;
-          return THE_NON_VALUE;
-        }
+    goto L_jump_start;
 
-	switch (val = EWASTACK_WPOP(ewa)) {
+ outer_loop:
+    while (!ESTACK_ISEMPTY(s)) {
+	obj = ESTACK_POP(s);
+	switch (val = WSTACK_POP(com)) {
 	case ENC_TERM:
-#if HALFWORD_HEAP
-        	obj = (Eterm) (wobj = EWASTACK_POP(ewa));
-#else
-	        obj = EWASTACK_POP(ewa);
-#endif
-
 	    break;
 	case ENC_ONE_CONS:
 	encode_one_cons:
 	    {
-                Eterm* cons;
+		Eterm* cons = list_val(obj);
 		Eterm tl;
 
-#if HALFWORD_HEAP
-         	obj = (Eterm) (wobj = EWASTACK_POP(ewa));
-#else
-        	obj = EWASTACK_POP(ewa);
-#endif
-                cons = list_val(obj);
 		obj = CAR(cons);
 		tl = CDR(cons);
-		EWASTACK_WPUSH(ewa, is_list(tl) ? ENC_ONE_CONS : ENC_TERM);
-		EWASTACK_PUSH(ewa, 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 */
 	    {
-                byte* size_p = (byte *) EWASTACK_WPOP(ewa);
+		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 */
+	    {
+		Eterm* ptr = tuple_val(obj);
+		i = arityval(*ptr);
+		obj = ptr[i];
+	    }
+	    break;
+	default:		/* ENC_LAST_ARRAY_ELEMENT+1 and upwards */
+	    {
+		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 arroy 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;
@@ -2043,7 +2172,34 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 	    break;
 
 	case SMALL_DEF:
-            ep = enc_small(obj, ep);
+	    {
+		/* From R14B we no longer restrict INTEGER_EXT to 28 bits,
+		 * as done earlier for backward compatibility reasons. */
+		Sint val = signed_val(obj);
+
+		if ((Uint)val < 256) {
+		    *ep++ = SMALL_INTEGER_EXT;
+		    put_int8(val, ep);
+		    ep++;
+		} else if (sizeof(Sint) == 4 || IS_SSMALL32(val)) {
+		    *ep++ = INTEGER_EXT;
+		    put_int32(val, ep);
+		    ep += 4;
+		} else {
+		    DeclareTmpHeapNoproc(tmp_big,2);
+		    Eterm big;
+		    UseTmpHeapNoproc(2);
+		    big = small_to_big(val, tmp_big);
+		    *ep++ = SMALL_BIG_EXT;
+		    n = big_bytes(big);
+		    ASSERT(n < 256);
+		    put_int8(n, ep);
+		    ep += 1;
+		    *ep++ = big_sign(big);
+		    ep = big_to_bytes(big, ep);
+		    UnUseTmpHeapNoproc(2);
+		}
+	    }
 	    break;
 
 	case BIG_DEF:
@@ -2130,7 +2286,6 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 		    *ep++ = LIST_EXT;
 		    put_int32(i, ep);
 		    ep += 4;
-                    EWASTACK_PUSH(ewa, obj);
 		    goto encode_one_cons;
 		}
 	    }
@@ -2149,10 +2304,9 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 		put_int32(i, ep);
 		ep += 4;
 	    }
-	    while (i > 0) {
-		EWASTACK_WPUSH(ewa, ENC_TERM);
-		EWASTACK_PUSH(ewa, (UWord) ptr[i-1]);
-                i--;
+	    if (i > 0) {
+		WSTACK_PUSH(com, ENC_LAST_ARRAY_ELEMENT+i-1);
+		ESTACK_PUSH(s, obj);
 	    }
 	    break;
 
@@ -2268,12 +2422,11 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 	case EXPORT_DEF:
 	    {
 		Export* exp = *((Export **) (export_val(obj) + 1));
-
 		if ((dflags & DFLAG_EXPORT_PTR_TAG) != 0) {
 		    *ep++ = EXPORT_EXT;
 		    ep = enc_atom(acmp, exp->code[0], ep, dflags);
 		    ep = enc_atom(acmp, exp->code[1], ep, dflags);
-		    ep = enc_small(make_small(exp->code[2]), ep);
+		    ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags, off_heap);
 		} else {
 		    /* Tag, arity */
 		    *ep++ = SMALL_TUPLE_EXT;
@@ -2297,8 +2450,9 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 		    int ei;
 
 		    *ep++ = NEW_FUN_EXT;
-		    EWASTACK_WPUSH(ewa, ENC_PATCH_FUN_SIZE);
-		    EWASTACK_WPUSH(ewa, (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;
@@ -2309,14 +2463,14 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 		    put_int32(funp->num_free, ep);
 		    ep += 4;
 		    ep = enc_atom(acmp, funp->fe->module, ep, dflags);
-		    ep = enc_small(make_small(funp->fe->old_index), ep);
-		    ep = enc_small(make_small(funp->fe->old_uniq), ep);
+		    ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap);
+		    ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap);
 		    ep = enc_pid(acmp, funp->creator, ep, dflags);
 
 		fun_env:
 		    for (ei = funp->num_free-1; ei > 0; ei--) {
-			EWASTACK_WPUSH(ewa, ENC_TERM);
-			EWASTACK_PUSH(ewa, (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];
@@ -2359,9 +2513,17 @@ BIF_RETTYPE enc_term_cont(Process *p, Eterm arg1)
 	    break;
 	}
     }
-    SAVE_TO_EWA;
-    // DESTROY_EWASTACK(ewa);
-    return arg1;
+    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
@@ -3149,51 +3311,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;
@@ -3205,6 +3363,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++;
@@ -3291,20 +3463,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:
@@ -3362,14 +3538,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);
 			}
 		    }
 		}
@@ -3400,8 +3576,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/external.h b/erts/emulator/beam/external.h
index cef773374e..e37d47919e 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -160,7 +160,7 @@ Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *);
 byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *);
 byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32);
 Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *);
-void erts_encode_dist_ext(Process *, Eterm, byte **, Uint32, ErtsAtomCacheMap *);
+void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *);
 
 Uint erts_encode_ext_size(Eterm);
 Uint erts_encode_ext_size_2(Eterm, unsigned);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index af245790d9..02087b4218 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);					\
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index d5d97d748a..d91ddb7eae 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;
     }