From c15cc0737b70ff5d4d1b79e8171106fcafcb1dda Mon Sep 17 00:00:00 2001
From: Rickard Green <rickard@erlang.org>
Date: Mon, 28 Apr 2014 23:55:12 +0200
Subject: Make binary BIFs converting from lists yield on large input

- erlang:list_to_binary/1
- erlang:iolist_to_binary/1
- erlang:list_to_bitstring/1
- binary:list_to_bin/1
---
 erts/emulator/beam/atom.names       |    1 +
 erts/emulator/beam/binary.c         | 1012 +++++++++++++++++++++++++++--------
 erts/emulator/beam/erl_bif_binary.c |   11 +-
 erts/emulator/beam/erl_binary.h     |    2 +-
 erts/emulator/beam/global.h         |   53 +-
 erts/emulator/beam/utils.c          |  490 +++++++++++++----
 erts/emulator/hipe/hipe_bif_list.m4 |    6 +-
 erts/emulator/test/binary_SUITE.erl |  175 +++++-
 8 files changed, 1408 insertions(+), 342 deletions(-)

(limited to 'erts')

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index d6e312fafd..5d06a32941 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -316,6 +316,7 @@ atom line_length
 atom linked_in_driver
 atom links
 atom list
+atom list_to_binary_continue
 atom little
 atom loaded
 atom load_cancelled
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index 4fd47210a2..f50d484576 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -31,17 +31,11 @@
 #include "erl_binary.h"
 #include "erl_bits.h"
 
-#ifdef DEBUG
-static int list_to_bitstr_buf(Eterm obj, char* buf, Uint len);
-#else
-static int list_to_bitstr_buf(Eterm obj, char* buf);
-#endif
-static int bitstr_list_len(Eterm obj, Uint* num_bytes);
-
 static Export binary_to_list_continue_export;
+static Export list_to_binary_continue_export;
 
 static BIF_RETTYPE binary_to_list_continue(BIF_ALIST_1);
-
+static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1);
 
 void
 erts_init_binary(void)
@@ -59,6 +53,10 @@ erts_init_binary(void)
 			  am_erts_internal, am_binary_to_list_continue, 1,
 			  &binary_to_list_continue);
 
+    erts_init_trap_export(&list_to_binary_continue_export,
+			  am_erts_internal, am_list_to_binary_continue, 1,
+			  &list_to_binary_continue);
+
 }
 
 /*
@@ -577,117 +575,433 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
 /* Turn a possibly deep list of ints (and binaries) into */
 /* One large binary object                               */
 
-/*
- * This bif also exists in the binary module, under the name
- * binary:list_to_bin/1, why it's divided into interface and
- * implementation. Also the backend for iolist_to_binary_1.
- */
+typedef enum {
+    ERTS_L2B_OK,
+    ERTS_L2B_YIELD,
+    ERTS_L2B_TYPE_ERROR,
+    ERTS_L2B_OVERFLOW_ERROR
+} ErtsL2BResult;
 
-BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg)
-{
+#define ERTS_L2B_STATE_INITER(C_P, ARG, BIF, SZFunc, TBufFunc)	\
+    {ERTS_IOLIST2BUF_STATE_INITER((C_P), (ARG)),				\
+	    (ARG), THE_NON_VALUE, (BIF), (SZFunc), (TBufFunc)}
+
+#define ERTS_L2B_STATE_MOVE(TO, FROM) \
+    sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsL2BState))
+
+typedef struct ErtsL2BState_ ErtsL2BState;
+
+struct ErtsL2BState_ {
+    ErtsIOList2BufState buf;
+    Eterm arg;
     Eterm bin;
-    Eterm h,t;
-    ErlDrvSizeT size;
-    byte* bytes;
-#ifdef DEBUG
-    ErlDrvSizeT offset;
-#endif
+    Export *bif;
+    int (*iolist_to_buf_size)(ErtsIOListState *);
+    ErlDrvSizeT (*iolist_to_buf)(ErtsIOList2BufState *);
+};
+
+static ERTS_INLINE ErtsL2BResult
+list_to_binary_engine(ErtsL2BState *sp)
+{
+    ErlDrvSizeT res;
+    Process *c_p = sp->buf.iolist.c_p;
+
+    /*
+     * have_size == 0 while sp->iolist_to_buf_size()
+     * has not finished the calculation.
+     */
+
+    if (!sp->buf.iolist.have_size) {
+	switch (sp->iolist_to_buf_size(&sp->buf.iolist)) {
+	case ERTS_IOLIST_YIELD:
+	    return ERTS_L2B_YIELD;
+	case ERTS_IOLIST_OVERFLOW:
+	    return ERTS_L2B_OVERFLOW_ERROR;
+	case ERTS_IOLIST_TYPE:
+	    return ERTS_L2B_TYPE_ERROR;
+	case ERTS_IOLIST_OK:
+	    break;
+	default:
+	    ASSERT(0);
+	    break;
+	}
+
+	ASSERT(sp->buf.iolist.have_size);
+
+	/*
+	 * Size calculated... Setup state for
+	 * sp->iolist_to_buf_*()
+	 */
+
+	sp->bin = new_binary(c_p,
+			     (byte *) NULL,
+			     sp->buf.iolist.size);
+
+	if (sp->buf.iolist.size == 0)
+	    return ERTS_L2B_OK;
+
+	sp->buf.buf = (char *) binary_bytes(sp->bin);
+	sp->buf.len = sp->buf.iolist.size;
+	sp->buf.iolist.obj = sp->arg;
 
-    if (is_nil(arg)) {
-	BIF_RET(new_binary(p,(byte*)"",0));
+	if (sp->buf.iolist.reds_left <= 0) {
+	    BUMP_ALL_REDS(c_p);
+	    return ERTS_L2B_YIELD;
+	}
     }
-    if (is_not_list(arg)) {
-	goto error;
+
+    ASSERT(sp->buf.iolist.size != 0);
+    ASSERT(is_value(sp->bin));
+    ASSERT(sp->buf.buf);
+
+    res = sp->iolist_to_buf(&sp->buf);
+
+    if (!ERTS_IOLIST_TO_BUF_FAILED(res)) {
+	ASSERT(res == 0);
+	return ERTS_L2B_OK;
     }
-    /* check for [binary()] case */
-    h = CAR(list_val(arg));
-    t = CDR(list_val(arg));
-    if (is_binary(h) && is_nil(t) && !(
-		HEADER_SUB_BIN == *(binary_val(h)) && (
-		    ((ErlSubBin *)binary_val(h))->bitoffs != 0 ||
-		    ((ErlSubBin *)binary_val(h))->bitsize != 0
-		))) {
-	return h;
-    }
-    switch (erts_iolist_size(arg, &size)) {
-    case ERTS_IOLIST_OVERFLOW: BIF_ERROR(p, SYSTEM_LIMIT);
-    case ERTS_IOLIST_TYPE: goto error;
-    default: ;
-    }
-    bin = new_binary(p, (byte *)NULL, size);
-    bytes = binary_bytes(bin);
-#ifdef DEBUG
-    offset = 
-#endif
-	erts_iolist_to_buf(arg, (char*) bytes, size);
 
-    ASSERT(offset == 0);
-    BIF_RET(bin);
+    switch (res) {
+    case ERTS_IOLIST_TO_BUF_YIELD:
+	return ERTS_L2B_YIELD;
+    case ERTS_IOLIST_TO_BUF_OVERFLOW:
+	return ERTS_L2B_OVERFLOW_ERROR;
+    case ERTS_IOLIST_TO_BUF_TYPE_ERROR:
+	return ERTS_L2B_TYPE_ERROR;
+    default:
+	ERTS_INTERNAL_ERROR("Invalid return value from iolist_to_buf_yielding()");
+	return ERTS_L2B_TYPE_ERROR;
+    }
+}
+
+static void
+l2b_state_destructor(Binary *mbp)
+{
+    ErtsL2BState *sp = ERTS_MAGIC_BIN_DATA(mbp); 
+    ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor);
+    DESTROY_SAVED_ESTACK(&sp->buf.iolist.estack);
+}
+
+static ERTS_INLINE Eterm
+l2b_final_touch(Process *c_p, ErtsL2BState *sp)
+{
+    Eterm *hp;
+    ErlSubBin* sbin; 
+    if (sp->buf.offset == 0)
+	return sp->bin;
+
+    hp = HAlloc(c_p, ERL_SUB_BIN_SIZE);
+    ASSERT(sp->buf.offset > 0);
+    sbin = (ErlSubBin *) hp;
+    sbin->thing_word = HEADER_SUB_BIN;
+    sbin->size = sp->buf.iolist.size-1;
+    sbin->offs = 0;
+    sbin->orig = sp->bin;
+    sbin->bitoffs = 0;
+    sbin->bitsize = sp->buf.offset;
+    sbin->is_writable = 0;
+    return make_binary(sbin);
+}
+
+static BIF_RETTYPE
+list_to_binary_chunk(Eterm mb_eterm,
+		     ErtsL2BState* sp,
+		     int reds_left,
+		     int gc_disabled)
+{
+    Eterm err = BADARG;
+    BIF_RETTYPE ret;
+    Process *c_p = sp->buf.iolist.c_p;
+
+    sp->buf.iolist.reds_left = reds_left;
     
- error:
-    BIF_ERROR(p, BADARG);
+    switch (list_to_binary_engine(sp)) {
+
+    case ERTS_L2B_OK: {
+	Eterm result = l2b_final_touch(c_p, sp);
+	if (!gc_disabled || !erts_set_gc_state(c_p, 1))
+	    ERTS_BIF_PREP_RET(ret, result);
+	else
+	    ERTS_BIF_PREP_YIELD_RETURN(ret, c_p, result);
+	ASSERT(!(c_p->flags & F_DISABLE_GC));
+	break;
+    }
+    case ERTS_L2B_YIELD:
+	if (!gc_disabled) {
+	    /* first yield... */
+	    Eterm *hp;
+	    Binary *mbp = erts_create_magic_binary(sizeof(ErtsL2BState),
+						   l2b_state_destructor);
+	    ErtsL2BState *new_sp = ERTS_MAGIC_BIN_DATA(mbp);
+
+	    ERTS_L2B_STATE_MOVE(new_sp, sp);
+	    sp = new_sp;
+
+	    hp = HAlloc(c_p, PROC_BIN_SIZE);
+	    mb_eterm = erts_mk_magic_binary_term(&hp, &MSO(c_p), mbp);
+
+	    ASSERT(is_value(mb_eterm));
+
+	    erts_set_gc_state(c_p, 0);
+	}
+
+	ASSERT(c_p->flags & F_DISABLE_GC);
+
+	ERTS_BIF_PREP_TRAP1(ret,
+			    &list_to_binary_continue_export,
+			    c_p,
+			    mb_eterm);
+	break;
+
+    case ERTS_L2B_OVERFLOW_ERROR:
+	err = SYSTEM_LIMIT;
+	/* fall through */
+
+    case ERTS_L2B_TYPE_ERROR:
+	if (!gc_disabled)
+	    ERTS_BIF_PREP_ERROR(ret, c_p, err);
+	else {
+	    if (erts_set_gc_state(c_p, 1))
+		ERTS_VBUMP_ALL_REDS(c_p);
+
+	    ERTS_BIF_PREP_ERROR_TRAPPED1(ret,
+					 c_p,
+					 err,
+					 sp->bif,
+					 sp->arg);
+	}
+
+	ASSERT(!(c_p->flags & F_DISABLE_GC));
+	break;
+
+    default:
+	ERTS_INTERNAL_ERROR("Invalid return value from list_to_binary_engine()");
+	ERTS_BIF_PREP_ERROR(ret,c_p, EXC_INTERNAL_ERROR);
+	break;
+    }
+    return ret;
+}
+
+static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1)
+{
+    Binary *mbp = ((ProcBin *) binary_val(BIF_ARG_1))->val;
+    ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) == l2b_state_destructor);
+
+    ASSERT(BIF_P->flags & F_DISABLE_GC);
+
+    return list_to_binary_chunk(BIF_ARG_1,
+				ERTS_MAGIC_BIN_DATA(mbp),
+				ERTS_BIF_REDS_LEFT(BIF_P),
+				1);
 }
 
+BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif)
+{
+    BIF_RETTYPE ret;
+
+    if (is_nil(arg))
+	ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0));
+    else if (is_not_list(arg))
+	ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+    else {
+	/* check for [binary()] case */
+	Eterm h = CAR(list_val(arg));
+	Eterm t = CDR(list_val(arg));
+	if (is_binary(h)
+	    && is_nil(t)
+	    && !(HEADER_SUB_BIN == *(binary_val(h))
+		 && (((ErlSubBin *)binary_val(h))->bitoffs != 0
+		     || ((ErlSubBin *)binary_val(h))->bitsize != 0))) {
+	    ERTS_BIF_PREP_RET(ret, h);
+	}
+	else {
+	    ErtsL2BState state = ERTS_L2B_STATE_INITER(c_p,
+						       arg,
+						       bif,
+						       erts_iolist_size_yielding,
+						       erts_iolist_to_buf_yielding);
+	    int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p);
+
+	    /*
+	     * First try to do it all at once without having to use
+	     * yielding iolist_to_buf().
+	     */
+	    state.buf.iolist.reds_left = orig_reds_left;
+	    switch (erts_iolist_size_yielding(&state.buf.iolist)) {
+	    case ERTS_IOLIST_OK: {
+		ErlDrvSizeT size = state.buf.iolist.size;
+		Eterm bin;
+		char *buf;
+
+		if (size == 0) {
+		    ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) NULL, 0));
+		    break; /* done */
+		}
+
+		bin = new_binary(c_p, (byte *) NULL, size);
+		buf = (char *) binary_bytes(bin);
+
+		if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) {
+		    /* An (over) estimation of reductions  needed */
+		    int reds_left = state.buf.iolist.reds_left;
+		    int to_buf_reds = orig_reds_left - reds_left;
+		    to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED;
+		    if (to_buf_reds <= reds_left) {
+			ErlDrvSizeT res;
+
+			res = erts_iolist_to_buf(arg, buf, size);
+			if (res == 0) {
+			    BUMP_REDS(c_p, to_buf_reds);
+			    ERTS_BIF_PREP_RET(ret, bin);
+			    break; /* done */
+			}
+			if (!ERTS_IOLIST_TO_BUF_FAILED(res))
+			    ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch");
+			if (res == ERTS_IOLIST_TO_BUF_OVERFLOW)
+			    goto overflow;
+			goto type_error;
+		    }
+		}
+		/*
+		 * Since size has been computed list_to_binary_chunk() expects
+		 * state prepared for iolist_to_buf.
+		 */
+		state.bin = bin;
+		state.buf.buf = buf;
+		state.buf.len = size;
+		state.buf.iolist.obj = arg;
+		/* Fall through... */
+	    }
+	    case ERTS_IOLIST_YIELD:
+		ret = list_to_binary_chunk(THE_NON_VALUE,
+					   &state,
+					   state.buf.iolist.reds_left,
+					   0);
+		break;
+	    case ERTS_IOLIST_OVERFLOW:
+	    overflow:
+		ERTS_BIF_PREP_ERROR(ret, c_p, SYSTEM_LIMIT);
+		break;
+	    case ERTS_IOLIST_TYPE:
+	    type_error:
+	    default:
+		ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
+		break;
+	    }
+	}
+    }
+    return ret;
+}
+
+HIPE_WRAPPER_BIF_DISABLE_GC(list_to_binary, 1)
+
 BIF_RETTYPE list_to_binary_1(BIF_ALIST_1)
 {
-    return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+    return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_list_to_binary_1]);
 }
 
-/* Turn a possibly deep list of ints (and binaries) into */
-/* One large binary object                               */
+HIPE_WRAPPER_BIF_DISABLE_GC(iolist_to_binary, 1)
 
 BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1)
 {
     if (is_binary(BIF_ARG_1)) {
 	BIF_RET(BIF_ARG_1);
     }
-    return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+    return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_iolist_to_binary_1]);
 }
 
+static int bitstr_list_len(ErtsIOListState *);
+static ErlDrvSizeT list_to_bitstr_buf_yielding(ErtsIOList2BufState *);
+static ErlDrvSizeT list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *);
+
+HIPE_WRAPPER_BIF_DISABLE_GC(list_to_bitstring, 1)
+
 BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1)
 {
-    Eterm bin;
-    Uint sz;
-    int offset;
-    byte* bytes;
-    ErlSubBin* sb1; 
-    Eterm* hp;
-    
-    if (is_nil(BIF_ARG_1)) {
-	BIF_RET(new_binary(BIF_P,(byte*)"",0));
-    }
-    if (is_not_list(BIF_ARG_1)) {
-    error:
-	BIF_ERROR(BIF_P, BADARG);
-    }
-    switch (bitstr_list_len(BIF_ARG_1, &sz)) {
-    case ERTS_IOLIST_TYPE:
-	goto error;
-    case ERTS_IOLIST_OVERFLOW:
-	BIF_ERROR(BIF_P, SYSTEM_LIMIT);
-    }
-    bin = new_binary(BIF_P, (byte *)NULL, sz);
-    bytes = binary_bytes(bin);
-#ifdef DEBUG
-    offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes, sz);
-#else
-    offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes);
-#endif
-    ASSERT(offset >= 0);
-    if (offset > 0) {
-	hp = HAlloc(BIF_P, ERL_SUB_BIN_SIZE);
-	sb1 = (ErlSubBin *) hp;
-	sb1->thing_word = HEADER_SUB_BIN;
-	sb1->size = sz-1;
-	sb1->offs = 0;
-	sb1->orig = bin;
-	sb1->bitoffs = 0;
-	sb1->bitsize = offset;
-	sb1->is_writable = 0;
-	bin = make_binary(sb1);
+    BIF_RETTYPE ret;
+
+    if (is_nil(BIF_ARG_1))
+	ERTS_BIF_PREP_RET(ret, new_binary(BIF_P, (byte *) "", 0));
+    else if (is_not_list(BIF_ARG_1))
+	ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+    else {
+	/* check for [bitstring()] case */
+	Eterm h = CAR(list_val(BIF_ARG_1));
+	Eterm t = CDR(list_val(BIF_ARG_1));
+	if (is_binary(h) && is_nil(t)) {
+	    ERTS_BIF_PREP_RET(ret, h);
+	}
+	else {
+	    ErtsL2BState state = ERTS_L2B_STATE_INITER(BIF_P,
+						       BIF_ARG_1,
+						       bif_export[BIF_list_to_bitstring_1],
+						       bitstr_list_len,
+						       list_to_bitstr_buf_yielding);
+	    int orig_reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+
+	    /*
+	     * First try to do it all at once without having to use
+	     * yielding list_to_bitstr_buf().
+	     */
+	    state.buf.iolist.reds_left = orig_reds_left;
+	    switch (bitstr_list_len(&state.buf.iolist)) {
+	    case ERTS_IOLIST_OK: {
+		ErlDrvSizeT size = state.buf.iolist.size;
+		
+		state.bin = new_binary(BIF_P, (byte *) NULL, size);
+		state.buf.buf = (char *) binary_bytes(state.bin);
+		state.buf.len = size;
+		state.buf.iolist.obj = BIF_ARG_1;
+
+		if (size < ERTS_IOLIST_TO_BUF_BYTES_PER_RED*CONTEXT_REDS) {
+		    /* An (over) estimation of reductions needed */
+		    int reds_left = state.buf.iolist.reds_left;
+		    int to_buf_reds = orig_reds_left - reds_left;
+		    to_buf_reds += size/ERTS_IOLIST_TO_BUF_BYTES_PER_RED;
+		    if (to_buf_reds <= reds_left) {
+			ErlDrvSizeT res;
+
+			res = list_to_bitstr_buf_not_yielding(&state.buf);
+			if (res == 0) {
+			    Eterm res_bin = l2b_final_touch(BIF_P, &state);
+			    BUMP_REDS(BIF_P, to_buf_reds);
+			    ERTS_BIF_PREP_RET(ret, res_bin);
+			    break; /* done */
+			}
+			if (!ERTS_IOLIST_TO_BUF_FAILED(res))
+			    ERTS_INTERNAL_ERROR("iolist_size/iolist_to_buf missmatch");
+			if (res == ERTS_IOLIST_TO_BUF_OVERFLOW)
+			    goto overflow;
+			goto type_error;
+		    }
+		}
+		/*
+		 * Since size has been computed list_to_binary_chunk() expects
+		 * the state prepared for list_to_bitstr_buf.
+		 */
+
+		/* Fall through... */
+	    }
+	    case ERTS_IOLIST_YIELD:
+		ret = list_to_binary_chunk(THE_NON_VALUE,
+					   &state,
+					   state.buf.iolist.reds_left,
+					   0);
+		break;
+	    case ERTS_IOLIST_OVERFLOW:
+	    overflow:
+		ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT);
+		break;
+	    case ERTS_IOLIST_TYPE:
+	    type_error:
+	    default:
+		ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+		break;
+	    }
+	}
     }
-    
-    BIF_RET(bin);
+
+    return ret;
 }
 
 BIF_RETTYPE split_binary_2(BIF_ALIST_2)
@@ -744,123 +1058,353 @@ BIF_RETTYPE split_binary_2(BIF_ALIST_2)
  * Local functions.
  */
 
+static int
+list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
+
 /*
  * The input list is assumed to be type-correct and the buffer is
  * assumed to be of sufficient size. Those assumptions are verified in
  * the DEBUG-built emulator.
  */
-static int
+static ErlDrvSizeT
+list_to_bitstr_buf(int yield_support, ErtsIOList2BufState *state)
+{
+
+#undef LIST_TO_BITSTR_BUF_BCOPY_DBG
+#undef LIST_TO_BITSTR_BUF_BCOPY
 #ifdef DEBUG
-list_to_bitstr_buf(Eterm obj, char* buf, Uint len)
+#define LIST_TO_BITSTR_BUF_BCOPY_DBG					\
+    len -= size + (offset>7);
 #else
-list_to_bitstr_buf(Eterm obj, char* buf)
+#define LIST_TO_BITSTR_BUF_BCOPY_DBG
 #endif
-{
-    Eterm* objp;
-    int offset = 0;
+#define LIST_TO_BITSTR_BUF_BCOPY(CONSP)					\
+    do {								\
+	byte* bptr;							\
+	Uint bitsize;							\
+	Uint bitoffs;							\
+	Uint num_bits;							\
+	size_t size = binary_size(obj);					\
+	if (yield_support) {						\
+	    size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;	\
+	    if (yield_count > 0)					\
+		max_size *= yield_count+1;				\
+	    if (size > max_size) {					\
+		state->objp = CONSP;					\
+		goto L_bcopy_yield;					\
+	    }								\
+	    if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {	\
+		int cost = (int) size;					\
+		cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;	\
+		yield_count -= cost;					\
+	    }								\
+	}								\
+	ASSERT(size <= len);						\
+	ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);		\
+	num_bits = 8*size+bitsize;					\
+	copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);	\
+	offset += bitsize;						\
+	buf += size + (offset>7);					\
+	LIST_TO_BITSTR_BUF_BCOPY_DBG;					\
+	offset = offset & 7;						\
+    } while(0)
+
+#ifdef DEBUG
+    ErlDrvSizeT len;
+#endif
+    Eterm obj;
+    char *buf;
+    Eterm *objp = NULL;
+    int offset;
+    int init_yield_count = 0, yield_count;
     DECLARE_ESTACK(s);
-    goto L_again;
-    
-    while (!ESTACK_ISEMPTY(s)) {
-	obj = ESTACK_POP(s);
-    L_again:
-	if (is_list(obj)) {
-	L_iter_list:
-	    objp = list_val(obj);
-	    obj = CAR(objp);
-	    if (is_byte(obj)) {
-		ASSERT(len > 0);
-		if (offset == 0) {
-		    *buf++ = unsigned_val(obj);
-		} else {
-		    *buf =  (char)((unsigned_val(obj) >> offset) | 
-				   ((*buf >> (8-offset)) << (8-offset)));
-		    buf++;
-		    *buf = (unsigned_val(obj) << (8-offset));
-		}   
+
+    obj = state->iolist.obj;
+    buf = state->buf;
+    offset = state->offset;
 #ifdef DEBUG
-		len--;
+    len = state->len;
 #endif
-	    } else if (is_binary(obj)) {
-		byte* bptr;
-		size_t size = binary_size(obj);
-		Uint bitsize;
-		Uint bitoffs;
-		Uint num_bits;
-		
-		ASSERT(size <= len);
-		ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
-		num_bits = 8*size+bitsize;
-		copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
-		offset += bitsize;
-		buf += size + (offset>7);
+
+    if (!yield_support) {
+	yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+	goto L_again;
+    }
+    else {
+
+	if (state->iolist.reds_left <= 0)
+	    return ERTS_IOLIST_TO_BUF_YIELD;
+
+	ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+	init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
+			    * state->iolist.reds_left);
+	yield_count = init_yield_count;
+
+	if (!state->iolist.estack.start)
+	    goto L_again;
+	else {
+	    int chk_stack;
+	    /* Restart; restore state... */
+	    ESTACK_RESTORE(s, &state->iolist.estack);
+
+	    if (!state->bcopy.bptr)
+		chk_stack = 0;
+	    else {
+		chk_stack = 1;
+		if (list_to_bitstr_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
+		    /* Yield again... */
+		    BUMP_ALL_REDS(state->iolist.c_p);
+		    state->iolist.reds_left = 0;
+		    ESTACK_SAVE(s, &state->iolist.estack);
+		    return ERTS_IOLIST_TO_BUF_YIELD;
+		}
+		buf = state->buf;
+		offset = state->offset;
 #ifdef DEBUG
-		len -= size + (offset>7);
+		len = state->len;
 #endif
-		offset = offset & 7;
-	    } else if (is_list(obj)) {
-		ESTACK_PUSH(s, CDR(objp));
-		goto L_iter_list; /* on head */
-	    } else {
-		ASSERT(is_nil(obj));
 	    }
 
-	    obj = CDR(objp);
-	    if (is_list(obj)) {
-		goto L_iter_list; /* on tail */
-	    } else if (is_binary(obj)) {
-		byte* bptr;
-		size_t size = binary_size(obj);
-		Uint bitsize;
-		Uint bitoffs;
-		Uint num_bits;
-
-		ASSERT(size <= len);
-		ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
-		num_bits = 8*size+bitsize;
-		copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
-		offset += bitsize;
-		buf += size+(offset>7);
+	    objp = state->objp;
+	    state->objp = NULL;
+
+	    if (objp)
+		goto L_tail;
+	    if (!chk_stack)
+		goto L_again;
+	    /* check stack */
+	}
+    }
+    
+    while (!ESTACK_ISEMPTY(s)) {
+	obj = ESTACK_POP(s);
+    L_again:
+	if (is_list(obj)) {
+	    while (1) { /* Tail loop */
+		while (1) { /* Head loop */
+		    if (yield_support && --yield_count <= 0)
+			goto L_yield;
+		    objp = list_val(obj);
+		    obj = CAR(objp);
+		    if (is_byte(obj)) {
+			ASSERT(len > 0);
+			if (offset == 0) {
+			    *buf++ = unsigned_val(obj);
+			} else {
+			    *buf =  (char)((unsigned_val(obj) >> offset) | 
+					   ((*buf >> (8-offset)) << (8-offset)));
+			    buf++;
+			    *buf = (unsigned_val(obj) << (8-offset));
+			}   
 #ifdef DEBUG
-		len -= size+(offset>7);
+			len--;
 #endif
-		offset = offset & 7;
-	    } else {
-		ASSERT(is_nil(obj));
+		    } else if (is_binary(obj)) {
+			LIST_TO_BITSTR_BUF_BCOPY(objp);
+		    } else if (is_list(obj)) {
+			ESTACK_PUSH(s, CDR(objp));
+			continue; /* Head loop */
+		    } else {
+			ASSERT(is_nil(obj));
+		    }
+		    break;
+		}
+
+	    L_tail:
+
+		obj = CDR(objp);
+		if (is_list(obj)) {
+		    continue; /* Tail loop */
+		} else if (is_binary(obj)) {
+		    LIST_TO_BITSTR_BUF_BCOPY(NULL);
+		} else {
+		    ASSERT(is_nil(obj));
+		}
+		break;
 	    }
 	} else if (is_binary(obj)) {
-	    byte* bptr;
-	    size_t size = binary_size(obj);
-	    Uint bitsize;
-	    Uint bitoffs;
-	    Uint num_bits;
-
-	    ASSERT(size <= len);
-	    ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
-	    num_bits = 8*size+bitsize;
-	    copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
-	    offset += bitsize;
-	    buf += size + (offset>7);
-#ifdef DEBUG
-	    len -= size + (offset>7);
-#endif
-	    offset = offset & 7;
+	    LIST_TO_BITSTR_BUF_BCOPY(NULL);
 	} else {
+	    if (yield_support && --yield_count <= 0)
+		goto L_yield;
 	    ASSERT(is_nil(obj));
 	}
     }
     
     DESTROY_ESTACK(s);
-    return offset;
+
+    if (yield_support) {
+	int reds;
+	CLEAR_SAVED_ESTACK(&state->iolist.estack);
+	reds = ((init_yield_count - yield_count - 1)
+		/ ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
+	BUMP_REDS(state->iolist.c_p, reds);
+	state->iolist.reds_left -= reds;
+	if (state->iolist.reds_left < 0)
+	    state->iolist.reds_left = 0;
+    }
+    state->buf = buf;
+    state->offset = offset;
+    return 0;
+
+L_bcopy_yield:
+
+    state->buf = buf;
+    state->offset = offset;
+#ifdef DEBUG
+    state->len = len;
+#endif
+
+    if (list_to_bitstr_buf_bcopy(state, obj, &yield_count) == 0)
+	ERTS_INTERNAL_ERROR("Missing yield");
+
+    BUMP_ALL_REDS(state->iolist.c_p);
+    state->iolist.reds_left = 0;
+    ESTACK_SAVE(s, &state->iolist.estack);
+    return ERTS_IOLIST_TO_BUF_YIELD;
+
+L_yield:
+
+    BUMP_ALL_REDS(state->iolist.c_p);
+    state->iolist.reds_left = 0;
+    state->iolist.obj = obj;
+    state->buf = buf;
+    state->offset = offset;
+    ESTACK_SAVE(s, &state->iolist.estack);
+#ifdef DEBUG
+    state->len = len;
+#endif
+    return ERTS_IOLIST_TO_BUF_YIELD;
+
+
+#undef LIST_TO_BITSTR_BUF_BCOPY_DBG
+#undef LIST_TO_BITSTR_BUF_BCOPY
+
+}
+
+static ErlDrvSizeT
+list_to_bitstr_buf_yielding(ErtsIOList2BufState *state)
+{
+    return list_to_bitstr_buf(1, state);
+}
+
+static ErlDrvSizeT
+list_to_bitstr_buf_not_yielding(ErtsIOList2BufState *state)
+{
+    return list_to_bitstr_buf(0, state);
 }
 
 static int
-bitstr_list_len(Eterm obj, Uint* num_bytes)
+list_to_bitstr_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
+{
+    int res;
+    char *buf = state->buf;
+    char *next_buf;
+    int offset = state->offset;
+    int next_offset;
+#ifdef DEBUG
+    ErlDrvSizeT len = state->len;
+    ErlDrvSizeT next_len;
+#endif
+    byte* bptr;
+    size_t size;
+    size_t max_size;
+    Uint bitoffs;
+    Uint num_bits;
+    Uint bitsize;
+    int yield_count = *yield_countp;
+
+    if (state->bcopy.bptr) {
+	bptr = state->bcopy.bptr;
+	size = state->bcopy.size;
+	bitoffs = state->bcopy.bitoffs;
+	bitsize = state->bcopy.bitsize;
+	state->bcopy.bptr = NULL;
+    }
+    else {
+
+	ASSERT(is_binary(obj));
+
+	size = binary_size(obj);
+
+	ASSERT(size <= len);
+
+	ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
+    }
+
+    max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+    if (yield_count > 0)
+	max_size *= (size_t) (yield_count+1);
+
+    if (size <= max_size) {
+	if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
+	    int cost = (int) size;
+	    cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+	    yield_count -= cost;
+	}
+	next_offset = offset + bitsize;
+	next_buf = buf + size+(next_offset>7);
+#ifdef DEBUG
+	next_len = len - size+(next_offset>7);
+#endif
+	next_offset &= 7;
+	num_bits = 8*size+bitsize;
+	res = 0;
+    }
+    else {
+	ASSERT(0 < max_size && max_size < size);
+	yield_count = 0;
+	state->bcopy.bptr = bptr + max_size;
+	state->bcopy.bitoffs = bitoffs;
+	state->bcopy.bitsize = bitsize;
+	state->bcopy.size = size - max_size;
+	next_buf = buf + max_size;
+#ifdef DEBUG
+	next_len = len - max_size;
+#endif
+	next_offset = offset;
+	num_bits = 8*max_size;
+	size = max_size;
+	res = 1;
+    }
+
+    copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
+
+    state->offset = next_offset;
+    state->buf = next_buf;
+#ifdef DEBUG
+    state->len = next_len;
+#endif
+    *yield_countp = yield_count;
+
+    return res;
+}
+
+static int
+bitstr_list_len(ErtsIOListState *state)
 {
     Eterm* objp;
-    Uint len = 0;
-    Uint offs = 0;
+    Eterm obj;
+    Uint len, offs;
+    int res, init_yield_count, yield_count;
     DECLARE_ESTACK(s);
+
+    if (state->reds_left <= 0)
+	return ERTS_IOLIST_YIELD;
+
+    len = (Uint) state->size;
+    offs = state->offs;
+    obj = state->obj;
+
+    ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+    init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
+    init_yield_count *= state->reds_left;
+    yield_count = init_yield_count;
+    if (state->estack.start) {
+	/* Restart; restore estack... */
+	ESTACK_RESTORE(s, &state->estack);
+    }
+
     goto L_again;
 
 #define SAFE_ADD(Var, Val)			\
@@ -887,46 +1431,55 @@ bitstr_list_len(Eterm obj, Uint* num_bytes)
 	obj = ESTACK_POP(s);
     L_again:
 	if (is_list(obj)) {
-	L_iter_list:
-	    objp = list_val(obj);
-	    /* Head */
-	    obj = CAR(objp);
-	    if (is_byte(obj)) {
-		len++;
-		if (len == 0) {
-		    goto L_overflow_error;
+	    while (1) { /* Tail loop */
+		while (1) { /* Head loop */
+		    if (--yield_count <= 0)
+			goto L_yield;
+		    objp = list_val(obj);
+		    /* Head */
+		    obj = CAR(objp);
+		    if (is_byte(obj)) {
+			len++;
+			if (len == 0) {
+			    goto L_overflow_error;
+			}
+		    } else if (is_binary(obj)) {
+			SAFE_ADD(len, binary_size(obj));
+			SAFE_ADD_BITSIZE(offs, obj);
+		    } else if (is_list(obj)) {
+			ESTACK_PUSH(s, CDR(objp));
+			continue; /* Head loop */
+		    } else if (is_not_nil(obj)) {
+			goto L_type_error;
+		    }
+		    break;
 		}
-	    } else if (is_binary(obj)) {
-		SAFE_ADD(len, binary_size(obj));
-		SAFE_ADD_BITSIZE(offs, obj);
-	    } else if (is_list(obj)) {
-		ESTACK_PUSH(s, CDR(objp));
-		goto L_iter_list; /* on head */
-	    } else if (is_not_nil(obj)) {
-		goto L_type_error;
+		/* Tail */
+		obj = CDR(objp);
+		if (is_list(obj))
+		    continue; /* Tail loop */
+		else if (is_binary(obj)) {
+		    SAFE_ADD(len, binary_size(obj));
+		    SAFE_ADD_BITSIZE(offs, obj);
+		} else if (is_not_nil(obj)) {
+		    goto L_type_error;
+		}
+		break;
 	    }
-	    /* Tail */
-	    obj = CDR(objp);
-	    if (is_list(obj))
-		goto L_iter_list; /* on tail */
-	    else if (is_binary(obj)) {
+	} else {
+	    if (--yield_count <= 0)
+		goto L_yield;
+	    if (is_binary(obj)) {
 		SAFE_ADD(len, binary_size(obj));
 		SAFE_ADD_BITSIZE(offs, obj);
 	    } else if (is_not_nil(obj)) {
 		goto L_type_error;
 	    }
-	} else if (is_binary(obj)) {
-	    SAFE_ADD(len, binary_size(obj));
-	    SAFE_ADD_BITSIZE(offs, obj);
-	} else if (is_not_nil(obj)) {
-	    goto L_type_error;
 	}
     }
 #undef SAFE_ADD
 #undef SAFE_ADD_BITSIZE
 
-    DESTROY_ESTACK(s);
-
     /*
      * Make sure that the number of bits in the bitstring will fit
      * in an Uint to ensure that the binary can be matched using
@@ -939,15 +1492,42 @@ bitstr_list_len(Eterm obj, Uint* num_bytes)
     if (len << 3 < len) {
 	goto L_overflow_error;
     }
-    *num_bytes = len;
-    return ERTS_IOLIST_OK;
+    state->size = len;
 
- L_type_error:
-    DESTROY_ESTACK(s);
-    return ERTS_IOLIST_TYPE;
+    res = ERTS_IOLIST_OK;
+
+ L_return: {
+	int yc = init_yield_count - yield_count;
+	int reds;
+
+	DESTROY_ESTACK(s);
+	CLEAR_SAVED_ESTACK(&state->estack);
+
+	reds = (yc - 1)/ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED + 1;
+	BUMP_REDS(state->c_p, reds);
+	state->reds_left -= reds;
+	state->size = (ErlDrvSizeT) len;
+	state->have_size = 1;
+	return res;
+    }
 
  L_overflow_error:
-    DESTROY_ESTACK(s);
-    return ERTS_IOLIST_OVERFLOW;
+    res = ERTS_IOLIST_OVERFLOW;
+    len = 0;
+    goto L_return;
+
+ L_type_error:
+    res = ERTS_IOLIST_TYPE;
+    len = 0;
+    goto L_return;
+
+ L_yield:
+    BUMP_ALL_REDS(state->c_p);
+    state->reds_left = 0;
+    state->size = len;
+    state->offs = offs;
+    state->obj = obj;
+    ESTACK_SAVE(s, &state->estack);
+    return ERTS_IOLIST_YIELD;
 }
 
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index ff775691b3..7e0e825a0d 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -2294,18 +2294,11 @@ BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1)
     BIF_ERROR(BIF_P,BADARG);
 }
 
-/*
- * Ok, erlang:list_to_binary does not interrupt, and we really don't want
- * an alternative implementation for the exact same thing, why we
- * have descided to use the old non-restarting implementation for now.
- * In reality, there are seldom many iterations involved in doing this, so the
- * problem of long-running bifs is not really that big in this case.
- * So, for now we use the old implementation also in the module binary.
- */
+HIPE_WRAPPER_BIF_DISABLE_GC(binary_list_to_bin, 1)
 
 BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1)
 {
-    return erts_list_to_binary_bif(BIF_P, BIF_ARG_1);
+    return erts_list_to_binary_bif(BIF_P, BIF_ARG_1, bif_export[BIF_binary_list_to_bin_1]);
 }
 
 typedef struct {
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 819b19e566..6c9f53ce87 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -166,7 +166,7 @@ Eterm erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size,
  * Common implementation for erlang:list_to_binary/1 and binary:list_to_bin/1
  */
 
-BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg);
+BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg, Export *bif);
 BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple);
 BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen);
 
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 8fcb95d0e2..891046a8b5 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -435,6 +435,8 @@ do {\
     }\
 } while(0)
 
+#define CLEAR_SAVED_ESTACK(estack) ((void) ((estack)->start = NULL))
+
 /*
  * Use on empty stack, only the allocator can be changed before this.
  * The src stack is reset to NULL.
@@ -551,6 +553,8 @@ do {\
     }\
 } while(0)
 
+#define CLEAR_SAVED_WSTACK(wstack) ((void) ((wstack)->wstart = NULL))
+
 /*
  * Use on empty stack, only the allocator can be changed before this.
  * The src stack is reset to NULL.
@@ -951,20 +955,67 @@ struct Sint_buf {
 };	
 char* Sint_to_buf(Sint, struct Sint_buf*);
 
+#define ERTS_IOLIST_STATE_INITER(C_P, OBJ)	\
+    {(C_P), 0, 0, (OBJ), {NULL, NULL, NULL, ERTS_ALC_T_INVALID}, 0, 0}
+
+#define ERTS_IOLIST_STATE_MOVE(TO, FROM)	\
+    sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOListState))
+
+#define ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED 8
+
+typedef struct {
+    Process *c_p;
+    ErlDrvSizeT size;
+    Uint offs;
+    Eterm obj;
+    ErtsEStack estack;
+    int reds_left;
+    int have_size;
+} ErtsIOListState;
+
+#define ERTS_IOLIST2BUF_STATE_INITER(C_P, OBJ)	\
+    {ERTS_IOLIST_STATE_INITER((C_P), (OBJ)), {NULL, 0, 0, 0}, NULL, 0, NULL, 0}
+
+#define ERTS_IOLIST2BUF_STATE_MOVE(TO, FROM)	\
+    sys_memcpy((void *) (TO), (void *) (FROM), sizeof(ErtsIOList2BufState))
+
+#define ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT 32
+#define ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED 8
+#define ERTS_IOLIST_TO_BUF_BYTES_PER_RED \
+    (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED*ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT)
+
+typedef struct {
+    ErtsIOListState iolist;
+    struct {
+	byte *bptr;
+	size_t size;
+	Uint bitoffs;
+	Uint bitsize;
+    } bcopy;
+    char *buf;
+    ErlDrvSizeT len;
+    Eterm *objp;
+    int offset;
+} ErtsIOList2BufState;
+
 #define ERTS_IOLIST_OK 0
 #define ERTS_IOLIST_OVERFLOW 1
 #define ERTS_IOLIST_TYPE 2
+#define ERTS_IOLIST_YIELD 3
 
 Eterm buf_to_intlist(Eterm**, const char*, size_t, Eterm); /* most callers pass plain char*'s */
 
 #define ERTS_IOLIST_TO_BUF_OVERFLOW	(~((ErlDrvSizeT) 0))
 #define ERTS_IOLIST_TO_BUF_TYPE_ERROR	(~((ErlDrvSizeT) 1))
+#define ERTS_IOLIST_TO_BUF_YIELD	(~((ErlDrvSizeT) 2))
 #define ERTS_IOLIST_TO_BUF_FAILED(R) \
-    (((R) & (~((ErlDrvSizeT) 1))) == (~((ErlDrvSizeT) 1)))
+    (((R) & (~((ErlDrvSizeT) 3))) == (~((ErlDrvSizeT) 3)))
 #define ERTS_IOLIST_TO_BUF_SUCCEEDED(R) \
     (!ERTS_IOLIST_TO_BUF_FAILED((R)))
 
 ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT);
+ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *);
+int erts_iolist_size_yielding(ErtsIOListState *state);
 int erts_iolist_size(Eterm, ErlDrvSizeT *);
 int is_string(Eterm);
 void erl_at_exit(void (*) (void*), void*);
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 738f793020..72092ec7b0 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -3197,106 +3197,303 @@ buf_to_intlist(Eterm** hpp, const char *buf, size_t len, Eterm tail)
 ** 
 */
 
-ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
+typedef enum {
+    ERTS_IL2B_BCOPY_OK,
+    ERTS_IL2B_BCOPY_YIELD,
+    ERTS_IL2B_BCOPY_OVERFLOW,
+    ERTS_IL2B_BCOPY_TYPE_ERROR
+} ErtsIL2BBCopyRes;
+
+static ErtsIL2BBCopyRes
+iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
+
+static ERTS_INLINE ErlDrvSizeT
+iolist_to_buf(const int yield_support,
+	      ErtsIOList2BufState *state,
+	      Eterm obj,
+	      char* buf,
+	      ErlDrvSizeT alloced_len)
 {
-    ErlDrvSizeT len = (ErlDrvSizeT) alloced_len;
-    Eterm* objp;
+#undef IOLIST_TO_BUF_BCOPY
+#define IOLIST_TO_BUF_BCOPY(CONSP)					\
+do {									\
+    size_t size = binary_size(obj);					\
+    if (size > 0) {							\
+	Uint bitsize;							\
+	byte* bptr;							\
+	Uint bitoffs;							\
+	Uint num_bits;							\
+	if (yield_support) {						\
+	    size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;	\
+	    if (yield_count > 0)					\
+		max_size *= yield_count+1;				\
+	    if (size > max_size) {					\
+		state->objp = CONSP;					\
+		goto L_bcopy_yield;					\
+	    }								\
+	    if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {	\
+		int cost = (int) size;					\
+		cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;	\
+		yield_count -= cost;					\
+	    }								\
+	}								\
+	if (len < size)							\
+	    goto L_overflow;						\
+	ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);		\
+	if (bitsize != 0)						\
+	    goto L_type_error;						\
+	num_bits = 8*size;						\
+	copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);		\
+	buf += size;							\
+	len -= size;							\
+    }									\
+} while (0)
+
+    ErlDrvSizeT res, len;
+    Eterm* objp = NULL;
+    int init_yield_count;
+    int yield_count;
     DECLARE_ESTACK(s);
-    goto L_again;
-    
-    while (!ESTACK_ISEMPTY(s)) {
-	obj = ESTACK_POP(s);
-    L_again:
-	if (is_list(obj)) {
-	L_iter_list:
-	    objp = list_val(obj);
-	    obj = CAR(objp);
-	    if (is_byte(obj)) {
-		if (len == 0) {
-		    goto L_overflow;
-		}
-		*buf++ = unsigned_val(obj);
-		len--;
-	    } else if (is_binary(obj)) {
-		byte* bptr;
-		size_t size = binary_size(obj);
-		Uint bitsize;
-		Uint bitoffs;
-		Uint num_bits;
-		
-		if (len < size) {
+
+    len = (ErlDrvSizeT) alloced_len;
+
+    if (!yield_support) {
+	yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+	goto L_again;
+    }
+    else {
+
+	if (state->iolist.reds_left <= 0)
+	    return ERTS_IOLIST_TO_BUF_YIELD;
+
+	ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+	init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
+			   * state->iolist.reds_left);
+	yield_count = init_yield_count;
+
+	if (!state->iolist.estack.start)
+	    goto L_again;
+	else {
+	    int chk_stack;
+	    /* Restart; restore state... */
+	    ESTACK_RESTORE(s, &state->iolist.estack);
+
+	    if (!state->bcopy.bptr)
+		chk_stack = 0;
+	    else {
+		chk_stack = 1;
+		switch (iolist_to_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
+		case ERTS_IL2B_BCOPY_OK:
+		    break;
+		case ERTS_IL2B_BCOPY_YIELD:
+		    BUMP_ALL_REDS(state->iolist.c_p);
+		    state->iolist.reds_left = 0;
+		    ESTACK_SAVE(s, &state->iolist.estack);
+		    return ERTS_IOLIST_TO_BUF_YIELD;
+		case ERTS_IL2B_BCOPY_OVERFLOW:
 		    goto L_overflow;
-		}
-		ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
-		if (bitsize != 0) {
+		case ERTS_IL2B_BCOPY_TYPE_ERROR:
 		    goto L_type_error;
 		}
-		num_bits = 8*size;
-		copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
-		buf += size;
-		len -= size;
-	    } else if (is_list(obj)) {
-		ESTACK_PUSH(s, CDR(objp));
-		goto L_iter_list; /* on head */
-	    } else if (is_not_nil(obj)) {
-		goto L_type_error;
 	    }
 
-	    obj = CDR(objp);
-	    if (is_list(obj)) {
-		goto L_iter_list; /* on tail */
-	    } else if (is_binary(obj)) {
-		byte* bptr;
-		size_t size = binary_size(obj);
-		Uint bitsize;
-		Uint bitoffs;
-		Uint num_bits;
-		if (len < size) {
-		    goto L_overflow;
+	    obj = state->iolist.obj;
+	    buf = state->buf;
+	    len = state->len;
+	    objp = state->objp;
+	    state->objp = NULL;
+	    if (objp)
+		goto L_tail;
+	    if (!chk_stack)
+		goto L_again;
+	    /* check stack */
+	}
+    }
+
+    while (!ESTACK_ISEMPTY(s)) {
+	obj = ESTACK_POP(s);
+    L_again:
+	if (is_list(obj)) {
+	    while (1) { /* Tail loop */
+		while (1) { /* Head loop */
+		    if (yield_support && --yield_count <= 0)
+			goto L_yield;
+		    objp = list_val(obj);
+		    obj = CAR(objp);
+		    if (is_byte(obj)) {
+			if (len == 0) {
+			    goto L_overflow;
+			}
+			*buf++ = unsigned_val(obj);
+			len--;
+		    } else if (is_binary(obj)) {
+			IOLIST_TO_BUF_BCOPY(objp);
+		    } else if (is_list(obj)) {
+			ESTACK_PUSH(s, CDR(objp));
+			continue; /* Head loop */
+		    } else if (is_not_nil(obj)) {
+			goto L_type_error;
+		    }
+		    break;
 		}
-		ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
-		if (bitsize != 0) {
+
+	    L_tail:
+
+		obj = CDR(objp);
+
+		if (is_list(obj)) {
+		    continue; /* Tail loop */
+		} else if (is_binary(obj)) {
+		    IOLIST_TO_BUF_BCOPY(NULL);
+		} else if (is_not_nil(obj)) {
 		    goto L_type_error;
 		}
-		num_bits = 8*size;
-		copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
-		buf += size;
-		len -= size;
-	    } else if (is_not_nil(obj)) {
-		goto L_type_error;
+		break;
 	    }
 	} else if (is_binary(obj)) {
-	    byte* bptr;
-	    size_t size = binary_size(obj);
-	    Uint bitsize;
-	    Uint bitoffs;
-	    Uint num_bits;
-	    if (len < size) {
-		goto L_overflow;
-	    }
-	    ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
-	    if (bitsize != 0) {
-		goto L_type_error;
-	    }
-	    num_bits = 8*size;
-	    copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
-	    buf += size;
-	    len -= size;
+	    IOLIST_TO_BUF_BCOPY(NULL);
 	} else if (is_not_nil(obj)) {
 	    goto L_type_error;
-	}
+	} else if (yield_support && --yield_count <= 0)
+	    goto L_yield;
     }
       
+    res = len;
+
+ L_return: 
+
     DESTROY_ESTACK(s);
-    return len;
+
+    if (yield_support) {
+	int reds;
+	CLEAR_SAVED_ESTACK(&state->iolist.estack);
+	reds = ((init_yield_count - yield_count - 1)
+		/ ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
+	BUMP_REDS(state->iolist.c_p, reds);
+	state->iolist.reds_left -= reds;
+	if (state->iolist.reds_left < 0)
+	    state->iolist.reds_left = 0;
+    }
+
+
+    return res;
 
  L_type_error:
-    DESTROY_ESTACK(s);
-    return ERTS_IOLIST_TO_BUF_TYPE_ERROR;
+    res = ERTS_IOLIST_TO_BUF_TYPE_ERROR;
+    goto L_return;
 
  L_overflow:
-    DESTROY_ESTACK(s);
-    return ERTS_IOLIST_TO_BUF_OVERFLOW;
+    res = ERTS_IOLIST_TO_BUF_OVERFLOW;
+    goto L_return;
+
+ L_bcopy_yield:
+
+    state->buf = buf;
+    state->len = len;
+
+    switch (iolist_to_buf_bcopy(state, obj, &yield_count)) {
+    case ERTS_IL2B_BCOPY_OK:
+	ERTS_INTERNAL_ERROR("Missing yield");
+    case ERTS_IL2B_BCOPY_YIELD:
+	BUMP_ALL_REDS(state->iolist.c_p);
+	state->iolist.reds_left = 0;
+	ESTACK_SAVE(s, &state->iolist.estack);
+	return ERTS_IOLIST_TO_BUF_YIELD;
+    case ERTS_IL2B_BCOPY_OVERFLOW:
+	goto L_overflow;
+    case ERTS_IL2B_BCOPY_TYPE_ERROR:
+	goto L_type_error;
+    }
+
+ L_yield:
+
+    BUMP_ALL_REDS(state->iolist.c_p);
+    state->iolist.reds_left = 0;
+    state->iolist.obj = obj;
+    state->buf = buf;
+    state->len = len;
+    ESTACK_SAVE(s, &state->iolist.estack);
+    return ERTS_IOLIST_TO_BUF_YIELD;
+
+#undef IOLIST_TO_BUF_BCOPY
+}
+
+static ErtsIL2BBCopyRes
+iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
+{
+    ErtsIL2BBCopyRes res;
+    char *buf = state->buf;
+    ErlDrvSizeT len = state->len;
+    byte* bptr;
+    size_t size;
+    size_t max_size;
+    Uint bitoffs;
+    Uint num_bits;
+    int yield_count = *yield_countp;
+
+    if (state->bcopy.bptr) {
+	bptr = state->bcopy.bptr;
+	size = state->bcopy.size;
+	bitoffs = state->bcopy.bitoffs;
+	state->bcopy.bptr = NULL;
+    }
+    else {
+	Uint bitsize;
+
+	ASSERT(is_binary(obj));
+
+	size = binary_size(obj);
+	if (size <= 0)
+	    return ERTS_IL2B_BCOPY_OK;
+
+	if (len < size)
+	    return ERTS_IL2B_BCOPY_OVERFLOW;
+
+	ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
+	if (bitsize != 0)
+	    return ERTS_IL2B_BCOPY_TYPE_ERROR;
+    }
+
+    ASSERT(size > 0);
+    max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+    if (yield_count > 0)
+	max_size *= (size_t) (yield_count+1);
+
+    if (size <= max_size) {
+	if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
+	    int cost = (int) size;
+	    cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
+	    yield_count -= cost;
+	}
+	res = ERTS_IL2B_BCOPY_OK;
+    }
+    else {
+	ASSERT(0 < max_size && max_size < size);
+	yield_count = 0;
+	state->bcopy.bptr = bptr + max_size;
+	state->bcopy.bitoffs = bitoffs;
+	state->bcopy.size = size - max_size;
+	size = max_size;
+	res = ERTS_IL2B_BCOPY_YIELD;
+    }
+
+    num_bits = 8*size;
+    copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
+    state->buf += size;
+    state->len -= size;
+    *yield_countp = yield_count;
+
+    return res;
+}
+
+ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *state)
+{
+    return iolist_to_buf(1, state, state->iolist.obj, state->buf, state->len);
+}
+
+ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
+{
+    return iolist_to_buf(0, NULL, obj, buf, alloced_len);
 }
 
 /*
@@ -3307,11 +3504,32 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
  * Any input term error detected in erts_iolist_to_buf should also
  * be detected in this function!
  */
-int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
+
+static ERTS_INLINE int
+iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSizeT* sizep)
 {
+    int res, init_yield_count, yield_count;
     Eterm* objp;
-    Uint size = 0; /* Intentionally Uint due to halfword heap */
+    Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */
     DECLARE_ESTACK(s);
+
+    if (!yield_support)
+	yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
+    else {
+	if (state->reds_left <= 0)
+	    return ERTS_IOLIST_YIELD;
+	ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+	init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
+	init_yield_count *= state->reds_left;
+	yield_count = init_yield_count;
+	if (state->estack.start) {
+	    /* Restart; restore state... */
+	    ESTACK_RESTORE(s, &state->estack);
+	    size = (Uint) state->size;
+	    obj = state->obj;
+	}
+    }
+
     goto L_again;
 
 #define SAFE_ADD(Var, Val)			\
@@ -3327,51 +3545,101 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
 	obj = ESTACK_POP(s);
     L_again:
 	if (is_list(obj)) {
-	L_iter_list:
-	    objp = list_val(obj);
-	    /* Head */
-	    obj = CAR(objp);
-	    if (is_byte(obj)) {
-		size++;
-		if (size == 0) {
-		    goto L_overflow_error;
+	    while (1) { /* Tail loop */
+		while (1) { /* Head loop */
+		    if (yield_support && --yield_count <= 0)
+			goto L_yield;
+		    objp = list_val(obj);
+		    /* Head */
+		    obj = CAR(objp);
+		    if (is_byte(obj)) {
+			size++;
+			if (size == 0) {
+			    goto L_overflow_error;
+			}
+		    } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+			SAFE_ADD(size, binary_size(obj));
+		    } else if (is_list(obj)) {
+			ESTACK_PUSH(s, CDR(objp));
+			continue; /* Head loop */
+		    } else if (is_not_nil(obj)) {
+			goto L_type_error;
+		    }
+		    break;
 		}
-	    } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
-		SAFE_ADD(size, binary_size(obj));
-	    } else if (is_list(obj)) {
-		ESTACK_PUSH(s, CDR(objp));
-		goto L_iter_list; /* on head */
-	    } else if (is_not_nil(obj)) {
-		goto L_type_error;
+		/* Tail */
+		obj = CDR(objp);
+		if (is_list(obj))
+		    continue; /* Tail loop */
+		else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+		    SAFE_ADD(size, binary_size(obj));
+		} else if (is_not_nil(obj)) {
+		    goto L_type_error;
+		}
+		break;
 	    }
-	    /* Tail */
-	    obj = CDR(objp);
-	    if (is_list(obj))
-		goto L_iter_list; /* on tail */
-	    else if (is_binary(obj) && binary_bitsize(obj) == 0) {
+	} else {
+	    if (yield_support && --yield_count <= 0)
+		goto L_yield;
+	    if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
 		SAFE_ADD(size, binary_size(obj));
 	    } else if (is_not_nil(obj)) {
 		goto L_type_error;
 	    }
-	} else if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
-	    SAFE_ADD(size, binary_size(obj));
-	} else if (is_not_nil(obj)) {
-	    goto L_type_error;
 	}
     }
 #undef SAFE_ADD
 
-    DESTROY_ESTACK(s);
     *sizep = (ErlDrvSizeT) size;
-    return ERTS_IOLIST_OK;
 
- L_overflow_error:
+    res = ERTS_IOLIST_OK;
+
+ L_return:
+
     DESTROY_ESTACK(s);
-    return ERTS_IOLIST_OVERFLOW;
+
+    if (yield_support) {
+	int yc, reds;
+	CLEAR_SAVED_ESTACK(&state->estack);
+	yc = init_yield_count - yield_count;
+	reds = ((yc - 1) / ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED) + 1;
+	BUMP_REDS(state->c_p, reds);
+	state->reds_left -= reds;
+	state->size = (ErlDrvSizeT) size;
+	state->have_size = 1;
+    }
+
+    return res;
+
+ L_overflow_error:
+    res = ERTS_IOLIST_OVERFLOW;
+    size = 0;
+    goto L_return;
 
  L_type_error:
-    DESTROY_ESTACK(s);
-    return ERTS_IOLIST_TYPE;
+    res = ERTS_IOLIST_TYPE;
+    size = 0;
+    goto L_return;
+
+ L_yield:
+    BUMP_ALL_REDS(state->c_p);
+    state->reds_left = 0;
+    state->size = size;
+    state->obj = obj;
+    ESTACK_SAVE(s, &state->estack);
+    return ERTS_IOLIST_YIELD;
+}
+
+int erts_iolist_size_yielding(ErtsIOListState *state)
+{
+    ErlDrvSizeT size = state->size;
+    return iolist_size(1, state, state->obj, &size);
+}
+
+int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
+{
+    *sizep = 0;
+    return iolist_size(0, NULL, obj, sizep);
 }
 
 /* return 0 if item is not a non-empty flat list of bytes */
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index e3563af61e..16765fdb99 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -273,7 +273,11 @@ ifelse($1,erts_internal_binary_to_term_2,hipe_wrapper_erts_internal_binary_to_te
 ifelse($1,binary_to_list_1,hipe_wrapper_binary_to_list_1,
 ifelse($1,binary_to_list_3,hipe_wrapper_binary_to_list_3,
 ifelse($1,bitstring_to_list_1,hipe_wrapper_bitstring_to_list_1,
-$1)))))))')
+ifelse($1,list_to_binary_1,hipe_wrapper_list_to_binary_1,
+ifelse($1,iolist_to_binary_1,hipe_wrapper_iolist_to_binary_1,
+ifelse($1,binary_list_to_bin_1,hipe_wrapper_binary_list_to_bin_1,
+ifelse($1,list_to_bitstring_1,hipe_wrapper_list_to_bitstring_1,
+$1)))))))))))')
 
 define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))')
 include(TARGET/`erl_bif_list.h')
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index fe34e60c27..04f3213ede 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -58,7 +58,8 @@
 	 ordering/1,unaligned_order/1,gc_test/1,
 	 bit_sized_binary_sizes/1,
 	 otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
-	 otp_8180/1, trapping/1, large/1]).
+	 otp_8180/1, trapping/1, large/1,
+	 error_after_yield/1]).
 
 %% Internal exports.
 -export([sleeper/0,trapping_loop/4]).
@@ -76,7 +77,8 @@ all() ->
      bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
      ordering, unaligned_order, gc_test,
      bit_sized_binary_sizes, otp_6817, otp_8117, deep,
-     obsolete_funs, robustness, otp_8180, trapping, large].
+     obsolete_funs, robustness, otp_8180, trapping, large,
+     error_after_yield].
 
 groups() -> 
     [].
@@ -1354,8 +1356,12 @@ trapping(Config) when is_list(Config)->
 		fun() -> [term_to_binary(lists:duplicate(2000000,2000000))] end),
     do_trapping(5, binary_to_list,
 		fun() -> [list_to_binary(lists:duplicate(2000000,$x))] end),
+    do_trapping(5, list_to_binary,
+		fun() -> [lists:duplicate(2000000,$x)] end),
     do_trapping(5, bitstring_to_list,
-		fun() -> [list_to_bitstring([lists:duplicate(2000000,$x),<<7:4>>])] end)
+		fun() -> [list_to_bitstring([lists:duplicate(2000000,$x),<<7:4>>])] end),
+    do_trapping(5, list_to_bitstring,
+		fun() -> [[lists:duplicate(2000000,$x),<<7:4>>]] end)
     .
 
 do_trapping(0, _, _) ->
@@ -1400,10 +1406,98 @@ large(Config) when is_list(Config) ->
     PartList = binary_to_list(Bin, 3, length(List)-2),
     ListBS = List ++ [<<7:4>>],
     ListBS = bitstring_to_list(list_to_bitstring(ListBS)),
+    BitStr1 = list_to_bitstring(lists:duplicate(1024*1024, [<<1,5:3>>])),
+    BitStr1 = list_to_bitstring(bitstring_to_list(BitStr1)),
+    BitStr2 = list_to_bitstring([lists:duplicate(512*1024, [<<1,5:3>>]),
+				Bin]),
+    BitStr2 = list_to_bitstring(bitstring_to_list(BitStr2)),
     ok.
 
+error_after_yield(Config) when is_list(Config) ->
+    L2BTrap = {erts_internal, list_to_binary_continue, 1},
+    error_after_yield(badarg, erlang, list_to_binary, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
+    error_after_yield(badarg, erlang, iolist_to_binary, 1, fun () -> [[list2iolist(mk_list(1000000)), oops]] end, L2BTrap),
+    error_after_yield(badarg, erlang, list_to_bitstring, 1, fun () -> [[list2bitstrlist(mk_list(1000000)), oops]] end, L2BTrap),
+    error_after_yield(badarg, binary, list_to_bin, 1, fun () -> [[mk_list(1000000), oops]] end, L2BTrap),
+
+    case erlang:system_info(wordsize) of
+	4 ->
+	    SysLimitSz = 1 bsl 32,
+	    error_after_yield(system_limit, erlang, list_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+	    error_after_yield(system_limit, erlang, iolist_to_binary, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+	    error_after_yield(system_limit, erlang, list_to_bitstring, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap),
+	    error_after_yield(system_limit, binary, list_to_bin, 1, fun () -> [[huge_iolist(SysLimitSz), $x]] end, L2BTrap);
+	8 ->
+	    % Takes waaaay to long time to test system_limit on 64-bit archs...
+	    ok
+    end,
+    ok.
+
+error_after_yield(Type, M, F, AN, AFun, TrapFunc) ->
+    io:format("Testing ~p for ~p:~p/~p~n", [Type, M, F, AN]),
+    Tracer = self(),
+    {Pid, Mon} = spawn_monitor(fun () ->
+				       A = AFun(),
+				       try
+					   erlang:yield(),
+					   erlang:trace(self(),true,[running,{tracer,Tracer}]),
+					   apply(M, F, A),
+					   exit({unexpected_success, {M, F, A}})
+				       catch
+					   error:Type ->
+					       erlang:trace(self(),false,[running,{tracer,Tracer}]),
+					       %% We threw the exception from the native
+					       %% function we trapped to, but we want
+					       %% the BIF that originally was called
+					       %% to appear in the stack trace.
+					       [{M, F, A, _} | _] = erlang:get_stacktrace()
+				       end
+			       end),
+    receive
+	{'DOWN', Mon, process, Pid, Reason} ->
+	    normal = Reason
+    end,
+    TD = erlang:trace_delivered(Pid),
+    receive
+	{trace_delivered, Pid, TD} ->
+	    NoYields = error_after_yield_sched(Pid, TrapFunc, 0),
+	    io:format("No of yields: ~p~n", [NoYields]),
+	    true =  NoYields > 10
+    end,
+    ok.
+
+error_after_yield_sched(P, TrapFunc, N) ->
+    receive
+	{trace, P, out, TrapFunc} ->
+	    receive
+		{trace, P, in, TrapFunc} ->
+		    error_after_yield_sched(P, TrapFunc, N+1)
+	    after 0 ->
+		    exit(trap_sched_mismatch)
+	    end;
+	{trace, P, out, Func} ->
+	    receive
+		{trace, P, in, Func} ->
+		    error_after_yield_sched(P, TrapFunc, N)
+	    after 0 ->
+		    exit(other_sched_mismatch)
+	    end
+    after 0 ->
+	    N
+    end.
+	    
+
 %% Utilities.
 
+huge_iolist(Lim) ->
+    Sz = 1024,
+    huge_iolist(list_to_binary(mk_list(Sz)), Sz, Lim).
+
+huge_iolist(X, Sz, Lim) when Sz >= Lim ->
+    X;
+huge_iolist(X, Sz, Lim) ->
+    huge_iolist([X, X], Sz*2, Lim).
+
 make_sub_binary(Bin) when is_binary(Bin) ->
     {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3),
     B;
@@ -1484,3 +1578,78 @@ get_reds() ->
 	    erts_debug:set_internal_state(available_internal_state, true),
 	    get_reds()
     end.
+
+-define(LARGE_BIN, (512*1024+10)).
+-define(LARGE_BIN_LIM, (1024*1024)).
+
+mk_list(0, Acc) ->
+    Acc;
+mk_list(Sz, Acc) ->
+    mk_list(Sz-1, [$A+(Sz band 63) | Acc]).
+
+mk_list(Sz) when Sz >= ?LARGE_BIN_LIM ->
+    SzLeft = Sz - ?LARGE_BIN,
+    SzHd = SzLeft div 2,
+    SzTl = SzLeft - SzHd,
+    [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])];
+mk_list(Sz) ->
+    mk_list(Sz, []).
+
+mk_list_lb(Sz) when Sz >= ?LARGE_BIN_LIM ->
+    SzLeft = Sz - ?LARGE_BIN,
+    SzHd = SzLeft div 2,
+    SzTl = SzLeft - SzHd,
+    [mk_list(SzHd, []), erlang:list_to_binary(mk_list(?LARGE_BIN, [])), mk_list(SzTl, [])];
+mk_list_lb(Sz) ->
+    mk_list(Sz, []).
+
+
+list2iolist(List) ->
+    list2iolist(List, []).
+
+list2iolist([], Acc) ->
+    Acc;
+list2iolist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256,
+						     is_integer(X1), 0 =< X1, X1 < 256,
+						     is_integer(X2), 0 =< X2, X2 < 256,
+						     is_integer(X3), 0 =< X3, X3 < 256,
+						     is_integer(X4), 0 =< X4, X4 < 256,
+						     is_integer(X5), 0 =< X5, X5 < 256 ->
+    NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of
+		 0 ->
+		     [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]];
+		 1 ->
+		     [Acc, [], erlang:list_to_binary([X0, X1, X2, X3, X4, X5])];
+		 2 ->
+		     [Acc, [[[[X0|erlang:list_to_binary([X1])],[X2|erlang:list_to_binary([X3])],[X4|erlang:list_to_binary([X5])]]]|<<"">>]];
+		 3 ->
+		     [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])]
+	     end,
+    list2iolist(Xs, NewAcc);
+list2iolist([X | Xs], Acc) ->
+    list2iolist(Xs, [Acc,X]).
+
+list2bitstrlist(List) ->
+    [list2bitstrlist(List, []), <<4:7>>].
+
+list2bitstrlist([], Acc) ->
+    Acc;
+list2bitstrlist([X0, X1, X2, X3, X4, X5 | Xs], Acc) when is_integer(X0), 0 =< X0, X0 < 256,
+						     is_integer(X1), 0 =< X1, X1 < 256,
+						     is_integer(X2), 0 =< X2, X2 < 256,
+						     is_integer(X3), 0 =< X3, X3 < 256,
+						     is_integer(X4), 0 =< X4, X4 < 256,
+						     is_integer(X5), 0 =< X5, X5 < 256 ->
+    NewAcc = case (X0+X1+X2+X3+X4+X5) band 3 of
+		 0 ->
+		     [Acc, [[[[[[[[[[[[X0,[],<<"">>,X1]]]]]]]]],[X2,X3]],[],[],[],[],X4],X5]];
+		 1 ->
+		     [Acc, [], <<X0:X1>>, <<X2:X3>>, <<X4:X5>>];
+		 2 ->
+		     [Acc, [[[[X0|<<X1:X2>>],X3]],[X4|erlang:list_to_binary([X5])]|<<"">>]];
+		 3 ->
+		     [Acc, X0, X1, X2, <<"">>, [], X3, X4 | erlang:list_to_binary([X5])]
+	     end,
+    list2bitstrlist(Xs, NewAcc);
+list2bitstrlist([X | Xs], Acc) ->
+    list2bitstrlist(Xs, [Acc,X]).
-- 
cgit v1.2.3