diff -r f43284a4103a -r 17e18582d287 erts/emulator/beam/atom.names
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -85,6 +85,7 @@ atom off_t
 atom off_t
 atom pid_t
 atom void
+atom erliovec
 
 #
 # All other atoms.  Try to keep the order alphabetic.
diff -r f43284a4103a -r 17e18582d287 erts/emulator/beam/erl_bif_ffi.c
--- a/erts/emulator/beam/erl_bif_ffi.c
+++ b/erts/emulator/beam/erl_bif_ffi.c
@@ -79,12 +79,14 @@ BIF_RETTYPE ffi_raw_buffer_to_binary_2(B
  * it for distinguishing among types).  The initialization will be
  * performed in erts_init_ffi() */
 ffi_type erl_ffi_type_binary;
+ffi_type erl_ffi_type_erliovec;
 ffi_type erl_ffi_type_cstring;
 ffi_type erl_ffi_type_nonnull;
 
 void erts_init_ffi(void)
 {
     erl_ffi_type_binary = ffi_type_pointer;
+    erl_ffi_type_erliovec = ffi_type_pointer;
     erl_ffi_type_cstring = ffi_type_pointer;
     erl_ffi_type_nonnull = ffi_type_pointer;
 }
@@ -137,6 +139,7 @@ static FFIConversion conversion_table[] 
 
     /* Erlang types */
     {am_binary, &erl_ffi_type_binary},
+    {am_erliovec, &erl_ffi_type_erliovec},
 
     /* Keep this at the end of the array */
     {am_false, NULL}
@@ -754,6 +757,31 @@ static int build_ffi_args_array(Eterm ar
             call_ptrs[i] = buf;
             offset += sizeof(ErlDrvBinary*);
             buf += sizeof(ErlDrvBinary*);
+	} else if (ftype == &erl_ffi_type_erliovec) {
+	    /* Build an ErlIOVec (putting the temporary allocations in
+	     * the proper arrays of pointers) */
+	    tmp_allocs[0] = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErlIOVec));
+
+	    /* Just in case the next call fails */
+	    tmp_allocs[1] = tmp_allocs[2] = tmp_allocs[3] = NULL;
+	    drv_allocs[0] = drv_allocs[1] = NULL;
+
+	    if (erts_io_list_to_vec(arg, (ErlIOVec*)tmp_allocs[0],
+				    NULL, NULL, 0,
+				    (SysIOVec**)&tmp_allocs[1],
+				    (ErlDrvBinary***)&tmp_allocs[2],
+				    drv_allocs) < 0)
+		return ERL_FFI_STATUS_BADARG;
+
+	    /* Use the ErlIOVec pointer */
+            *((ErlIOVec**)buf) = (ErlIOVec*)tmp_allocs[0];
+            call_ptrs[i] = buf;
+            offset += sizeof(ErlIOVec*);
+            buf += sizeof(ErlIOVec*);
+
+	    /* The arrays have been NULL-terminated above */
+	    tmp_allocs += 3;
+	    ++drv_allocs;
         } else {
             /* It should never happen */
             return ERL_FFI_STATUS_BUG;
diff -r f43284a4103a -r 17e18582d287 erts/emulator/beam/global.h
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -890,6 +890,13 @@ ErtsPortNames *erts_get_port_names(Eterm
 ErtsPortNames *erts_get_port_names(Eterm);
 void erts_free_port_names(ErtsPortNames *);
 Uint erts_port_ioq_size(Port *pp);
+int erts_io_list_to_vec(Eterm list, ErlIOVec *ev,
+			SysIOVec iv[],
+			ErlDrvBinary *bv[],
+			Uint iv_bv_size,
+			SysIOVec *out_ivp[],
+			ErlDrvBinary **out_bvp[],
+			ErlDrvBinary **out_cbin);
 void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int);
 /* use erts_port_ready_input() instead of input_ready() */
 void input_ready(int, int) __deprecated;
diff -r f43284a4103a -r 17e18582d287 erts/emulator/beam/io.c
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1097,6 +1097,85 @@ io_list_vec_len(Eterm obj, int* vsize, i
 #define ERL_SMALL_IO_BIN_LIMIT (4*ERL_ONHEAP_BIN_LIMIT)
 #define SMALL_WRITE_VEC  16
 
+/* Build an ErlIOVec from an iolist, ready to be sent to a port or
+ * used for a FFI call.
+ *
+ * 'iv' and 'bv' are preallocated arrays (with length 'iv_bv_size')
+ * that the function could overwrite when creating the SysIOVec.  If
+ * 'iv_bv_size' is not enough, a new allocation will be performed, and
+ * the 'out_ivp' and 'out_bvp' output variables will be set to
+ * something different than 'iv' and 'bv' (in that case, they will
+ * need to be deallocated with ERTS_ALC_T_TMP).  'out_cbin' will *always*
+ * require deallocation with driver_free_binary().
+ *
+ * The function will return the SysIOVec size on success, or a
+ * negative value on error. */
+int erts_io_list_to_vec(Eterm list, ErlIOVec *ev,
+			SysIOVec iv[],
+			ErlDrvBinary *bv[],
+			Uint iv_bv_size,
+			SysIOVec *out_ivp[],
+			ErlDrvBinary **out_bvp[],
+			ErlDrvBinary **out_cbin)
+{
+    int size;
+    int vsize;
+    int csize;
+    int pvsize;
+    int pcsize;
+    int blimit;
+    SysIOVec *ivp;
+    ErlDrvBinary **bvp;
+    ErlDrvBinary *cbin;
+
+    if ((size = io_list_vec_len(list, &vsize, &csize, 
+				ERL_SMALL_IO_BIN_LIMIT,
+				&pvsize, &pcsize)) < 0) {
+	return size;
+    }
+    /* To pack or not to pack (small binaries) ...? */
+    vsize++;
+    if (vsize <= iv_bv_size) {
+	/* Do NOT pack */
+	blimit = 0;
+    } else {
+	/* Do pack */
+	vsize = pvsize + 1;
+	csize = pcsize;
+	blimit = ERL_SMALL_IO_BIN_LIMIT;
+    }
+    /* Use vsize and csize from now on */
+    if (vsize <= iv_bv_size) {
+	ivp = *out_ivp = iv;
+	bvp = *out_bvp = bv;
+    } else {
+	ivp = *out_ivp = (SysIOVec *) erts_alloc(ERTS_ALC_T_TMP,
+						 vsize * sizeof(SysIOVec));
+	bvp = *out_bvp = (ErlDrvBinary**) erts_alloc(ERTS_ALC_T_TMP,
+						     vsize
+						     * sizeof(ErlDrvBinary*));
+    }
+    cbin = *out_cbin = driver_alloc_binary(csize);
+    if (!cbin)
+	erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, sizeof(Binary) + csize);
+
+    /* Element 0 is for driver usage to add header block */
+    (ivp)[0].iov_base = NULL;
+    (ivp)[0].iov_len = 0;
+    (bvp)[0] = NULL;
+    ev->vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit);
+    ev->vsize++;
+#if 0
+    /* This assertion may say something useful, but it can
+       be falsified during the emulator test suites. */
+    ASSERT((ev->vsize >= 0) && (ev->vsize == vsize));
+#endif
+    ev->size = size;  /* total size */
+    ev->iov = ivp;
+    ev->binv = bvp;
+
+    return size;
+}
 
 /* write data to a port */
 int erts_write_to_port(Eterm caller_id, Port *p, Eterm list)
@@ -1110,62 +1189,17 @@ int erts_write_to_port(Eterm caller_id, 
 
     p->caller = caller_id;
     if (drv->outputv != NULL) {
-	int vsize;
-	int csize;
-	int pvsize;
-	int pcsize;
-	int blimit;
+	ErlIOVec ev;
 	SysIOVec iv[SMALL_WRITE_VEC];
 	ErlDrvBinary* bv[SMALL_WRITE_VEC];
 	SysIOVec* ivp;
 	ErlDrvBinary**  bvp;
 	ErlDrvBinary* cbin;
-	ErlIOVec ev;
-
-	if ((size = io_list_vec_len(list, &vsize, &csize, 
-				    ERL_SMALL_IO_BIN_LIMIT,
-				    &pvsize, &pcsize)) < 0) {
+	
+	if (erts_io_list_to_vec(list, &ev, iv, bv, SMALL_WRITE_VEC,
+				&ivp, &bvp, &cbin) < 0)
 	    goto bad_value;
-	}
-	/* To pack or not to pack (small binaries) ...? */
-	vsize++;
-	if (vsize <= SMALL_WRITE_VEC) {
-	    /* Do NOT pack */
-	    blimit = 0;
-	} else {
-	    /* Do pack */
-	    vsize = pvsize + 1;
-	    csize = pcsize;
-	    blimit = ERL_SMALL_IO_BIN_LIMIT;
-	}
-	/* Use vsize and csize from now on */
-	if (vsize <= SMALL_WRITE_VEC) {
-	    ivp = iv;
-	    bvp = bv;
-	} else {
-	    ivp = (SysIOVec *) erts_alloc(ERTS_ALC_T_TMP,
-					  vsize * sizeof(SysIOVec));
-	    bvp = (ErlDrvBinary**) erts_alloc(ERTS_ALC_T_TMP,
-					      vsize * sizeof(ErlDrvBinary*));
-	}
-	cbin = driver_alloc_binary(csize);
-	if (!cbin)
-	    erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, sizeof(Binary) + csize);
-
-	/* Element 0 is for driver usage to add header block */
-	ivp[0].iov_base = NULL;
-	ivp[0].iov_len = 0;
-	bvp[0] = NULL;
-	ev.vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit);
-	ev.vsize++;
-#if 0
-	/* This assertion may say something useful, but it can
-	   be falsified during the emulator test suites. */
-	ASSERT((ev.vsize >= 0) && (ev.vsize == vsize));
-#endif
-	ev.size = size;  /* total size */
-	ev.iov = ivp;
-	ev.binv = bvp;
+
 	(*drv->outputv)((ErlDrvData)p->drv_data, &ev);
 	if (ivp != iv) {
 	    erts_free(ERTS_ALC_T_TMP, (void *) ivp);
