diff -r f1993a64f66c -r 25dc4ec2c60b erts/configure.in
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -539,6 +539,15 @@ AC_CHECK_LIB(inet, main)
 AC_CHECK_LIB(inet, main)
 AC_CHECK_LIB(util, openpty)
 
+# Remove ffi SKIP file from previous run
+/bin/rm -f $ERL_TOP/lib/ffi/SKIP
+
+AC_CHECK_LIB(ffi, ffi_prep_cif)
+
+if test "x$ac_cv_lib_ffi_ffi_prep_cif" != "xyes"; then
+    echo "No usable libffi found" > $ERL_TOP/lib/ffi/SKIP
+fi
+
 dnl Try to find a thread library.
 dnl
 dnl ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS, ETHR_THR_LIB_BASE and ETHR_DEFS
@@ -1089,6 +1098,49 @@ AC_CHECK_SIZEOF(long, 4)dnl Assumes all 
 AC_CHECK_SIZEOF(long, 4)dnl Assumes all cross compiling is to 32bit uP
 AC_CHECK_SIZEOF(void *, 4)dnl Assumes all cross compiling is to 32bit uP
 AC_CHECK_SIZEOF(long long, 0)
+
+dnl Type sizes needed by FFI
+AC_CHECK_SIZEOF(unsigned short, 0)
+AC_CHECK_SIZEOF(unsigned int, 0)
+AC_CHECK_SIZEOF(unsigned long, 0)
+AC_CHECK_SIZEOF(float, 0)
+AC_CHECK_SIZEOF(double, 0)
+AC_CHECK_SIZEOF(long double, 0)
+AC_CHECK_SIZEOF(size_t, 0)
+AC_CHECK_SIZEOF(ssize_t, 0)
+AC_CHECK_SIZEOF(off_t, 0)
+AC_CHECK_SIZEOF(pid_t, 0)
+
+dnl Compute and substitute type sizes (in bytes and bits)
+AC_SUBST([SIZEOF_UNSIGNED_SHORT], [$ac_cv_sizeof_unsigned_short])
+AC_SUBST([SIZEOF_SHORT],          [$ac_cv_sizeof_short])
+AC_SUBST([SIZEOF_UNSIGNED_INT],   [$ac_cv_sizeof_unsigned_int])
+AC_SUBST([SIZEOF_INT],            [$ac_cv_sizeof_int])
+AC_SUBST([SIZEOF_UNSIGNED_LONG],  [$ac_cv_sizeof_unsigned_long])
+AC_SUBST([SIZEOF_LONG],           [$ac_cv_sizeof_long])
+AC_SUBST([SIZEOF_FLOAT],          [$ac_cv_sizeof_float])
+AC_SUBST([SIZEOF_DOUBLE],         [$ac_cv_sizeof_double])
+AC_SUBST([SIZEOF_LONG_DOUBLE],    [$ac_cv_sizeof_long_double])
+AC_SUBST([SIZEOF_VOID_P],         [$ac_cv_sizeof_void_p])
+AC_SUBST([SIZEOF_SIZE_T],         [$ac_cv_sizeof_size_t])
+AC_SUBST([SIZEOF_SSIZE_T],        [$ac_cv_sizeof_ssize_t])
+AC_SUBST([SIZEOF_OFF_T],          [$ac_cv_sizeof_off_t])
+AC_SUBST([SIZEOF_PID_T],          [$ac_cv_sizeof_pid_t])
+
+AC_SUBST([UNSIGNED_SHORT_BITS], [$((SIZEOF_UNSIGNED_SHORT * 8))])
+AC_SUBST([SHORT_BITS],          [$((SIZEOF_SHORT * 8))])
+AC_SUBST([UNSIGNED_INT_BITS],   [$((SIZEOF_UNSIGNED_INT * 8))])
+AC_SUBST([INT_BITS],            [$((SIZEOF_INT * 8))])
+AC_SUBST([UNSIGNED_LONG_BITS],  [$((SIZEOF_UNSIGNED_LONG * 8))])
+AC_SUBST([LONG_BITS],           [$((SIZEOF_LONG * 8))])
+AC_SUBST([FLOAT_BITS],          [$((SIZEOF_FLOAT * 8))])
+AC_SUBST([DOUBLE_BITS],         [$((SIZEOF_DOUBLE * 8))])
+AC_SUBST([LONG_DOUBLE_BITS],    [$((SIZEOF_LONG_DOUBLE * 8))])
+AC_SUBST([VOID_P_BITS],         [$((SIZEOF_VOID_P * 8))])
+AC_SUBST([SIZE_T_BITS],         [$((SIZEOF_SIZE_T * 8))])
+AC_SUBST([SSIZE_T_BITS],        [$((SIZEOF_SSIZE_T * 8))])
+AC_SUBST([OFF_T_BITS],          [$((SIZEOF_OFF_T * 8))])
+AC_SUBST([PID_T_BITS],          [$((SIZEOF_PID_T * 8))])
 
 BITS64=
 
@@ -2957,5 +3009,6 @@ dnl
   ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in
   ../lib/tools/c_src/$host/Makefile:../lib/tools/c_src/Makefile.in
   ../lib/asn1/c_src/$host/Makefile:../lib/asn1/c_src/Makefile.in
+  ../lib/ffi/include/$host/ffi_hardcodes.hrl:../lib/ffi/include/ffi_hardcodes.hrl.in
   )
 
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/Makefile.in
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -695,7 +695,7 @@ RUN_OBJS = \
 	$(OBJDIR)/erl_term.o 		$(OBJDIR)/erl_node_tables.o \
 	$(OBJDIR)/erl_monitors.o	$(OBJDIR)/erl_process_dump.o \
 	$(OBJDIR)/erl_obsolete.o	$(OBJDIR)/erl_bif_timer.o \
-	$(OBJDIR)/erl_port_task.o
+	$(OBJDIR)/erl_port_task.o       $(OBJDIR)/erl_bif_ffi.o
 
 ifeq ($(TARGET),win32)
 DRV_OBJS = \
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/atom.names
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -56,11 +56,44 @@ atom undefined_lambda
 atom undefined_lambda
 
 #
+# FFI atoms.
+#
+atom uchar
+atom schar
+atom ushort
+atom sshort
+atom uint
+atom sint
+atom ulong
+atom slong
+atom uint8
+atom sint8
+atom uint16
+atom sint16
+atom uint32
+atom sint32
+atom uint64
+atom sint64
+atom float
+atom double
+atom longdouble
+atom pointer
+atom cstring
+atom nonnull
+atom size_t
+atom ssize_t
+atom off_t
+atom pid_t
+atom void
+atom erliovec
+
+#
 # All other atoms.  Try to keep the order alphabetic.
 #
 atom DOWN='DOWN'
 atom UP='UP'
 atom EXIT='EXIT'
+atom address
 atom all
 atom allocated
 atom allocated_areas
@@ -262,6 +295,7 @@ atom name
 atom name
 atom named_table
 atom native_addresses
+atom need_driver_init
 atom Neq='=/='
 atom Neqeq='/='
 atom net_kernel
@@ -327,6 +361,8 @@ atom pid
 atom pid
 atom port
 atom port_count
+atom preload
+atom preloads
 atom print
 atom priority
 atom private
@@ -375,6 +411,7 @@ atom set_tcw
 atom set_tcw
 atom set_tcw_fake
 atom separate
+atom signature
 atom shared
 atom silent
 atom size
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/bif.tab
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -686,3 +686,11 @@ bif erlang:old_binary_to_term/1
 #
 #bif erlang:concat_binary/1
 #bif erlang:info/1
+
+#
+# FFI BIFs
+#
+bif ffi:raw_cstring_to_binary/1
+bif ffi:raw_buffer_to_binary/2
+bif ffi:raw_call/3
+bif ffi:raw_call/2
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/erl_bif_ddll.c
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -13,6 +13,10 @@
  * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
  * AB. All Rights Reserved.''
  * 
+ * FFI and generic library loading support:
+ *     Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+ *     Author: Alceste Scalas <alceste@crs4.it>
+ *
  *     $Id$
  */
 /*
@@ -41,6 +45,8 @@
 #include "big.h"
 #include "dist.h"
 #include "erl_version.h"
+#include "erl_bif_ffi.h"
+#include "erl_bits.h"
 
 #ifdef ERTS_SMP
 #define DDLL_SMP 1
@@ -69,9 +75,12 @@ static void add_proc_loaded(DE_Handle *d
 static void add_proc_loaded(DE_Handle *dh, Process *proc); 
 static void add_proc_loaded_deref(DE_Handle *dh, Process *proc);
 static void set_driver_reloading(DE_Handle *dh, Process *proc, char *path, char *name, Uint flags);
-static int load_driver_entry(DE_Handle **dhp, char *path, char *name);
-static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name);
-static int do_load_driver_entry(DE_Handle *dh, char *path, char *name);
+static int load_driver_entry(DE_Handle **dhp, char *path, char *name,
+			     int need_driver_init);
+static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name,
+				  int keep_preloads);
+static int do_load_driver_entry(DE_Handle *dh, char *path, char *name,
+				int need_driver_init);
 #if 0
 static void unload_driver_entry(DE_Handle *dh);
 #endif
@@ -96,6 +105,12 @@ static void dereference_all_processes(DE
 static void dereference_all_processes(DE_Handle *dh);
 static void restore_process_references(DE_Handle *dh);
 static void ddll_no_more_references(void *vdh);
+#ifdef HAVE_LIBFFI
+static int build_ffi_preloads(Eterm lst, FFIPreload **preloads,
+			      DE_Handle *dh);
+static void refresh_ffi_preloads(DE_Handle *dh);
+static Eterm build_preloads_info(Process *p, DE_Handle *dh);
+#endif /* HAVE_LIBFFI */
 
 #define lock_drv_list() erts_smp_mtx_lock(&erts_driver_list_lock)
 #define unlock_drv_list() erts_smp_mtx_unlock(&erts_driver_list_lock)
@@ -115,7 +130,8 @@ static void ddll_no_more_references(void
  *	 OptionList = [ Option ]
  *	 Option = {driver_options, DriverOptionList} | 
  *                {monitor,MonitorOption} | 
- *                {reload, ReloadOption}
+ *                {reload, ReloadOption} |
+ *                {need_driver_init, true | false}
  *	 DriverOptionList = [ DriverOption ]
  *	 DriverOption = kill_ports
  *	 MonitorOption = pending_driver | pending
@@ -156,6 +172,12 @@ BIF_RETTYPE erl_ddll_try_load_3(Process 
     int kill_ports = 0;
     int do_build_load_error = 0;
     int build_this_load_error = 0;
+    int need_driver_init = 1;
+#ifdef HAVE_LIBFFI
+    FFIPreload *preloads = NULL;
+    int npreloads = 0; /* Number of FFI preloads */
+#endif /* HAVE_LIBFFI */
+    Eterm preloads_lst = am_false;
 
     for(l = options; is_list(l); l =  CDR(list_val(l))) {
 	Eterm opt = CAR(list_val(l));
@@ -201,6 +223,21 @@ BIF_RETTYPE erl_ddll_try_load_3(Process 
 	    } else {
 		goto error;
 	    }
+	    break;
+	case am_need_driver_init:
+	    if (tp[2] == am_true) {
+		need_driver_init = 1;
+	    } else if (tp[2] == am_false ) {
+		need_driver_init = 0;
+	    } else {
+		goto error;
+	    }
+	    break;
+	case am_preload:
+	    if (is_not_list(tp[2]) && is_not_nil(tp[2])) {
+		goto error;
+	    }
+	    preloads_lst = tp[2];
 	    break;
 	default:
 	    goto error;
@@ -334,7 +371,8 @@ BIF_RETTYPE erl_ddll_try_load_3(Process 
 	    soft_error_term = am_not_loaded;
 	    goto soft_error;
 	} 
-	if ((res = load_driver_entry(&dh, path, name)) !=  ERL_DE_NO_ERROR) {
+	if ((res = load_driver_entry(&dh, path, name,
+				     need_driver_init)) != ERL_DE_NO_ERROR) {
 	    build_this_load_error = res;
 	    do_build_load_error = 1;
 	    soft_error_term = am_undefined;
@@ -407,6 +445,31 @@ BIF_RETTYPE erl_ddll_try_load_3(Process 
 	hp = HAlloc(p,3);
 	t = TUPLE2(hp, am_ok, ok_term);
     }
+
+    if (preloads_lst != am_false) {
+	/* We are required to (re)build the FFI preload list.  Even if
+	 * we fail, the driver/library will remain loaded (but without
+	 * the preloaded symbols).  It will be possible to repeat the
+	 * preloading by (re)loading the driver/library again. */
+#ifdef HAVE_LIBFFI
+	if ((npreloads = build_ffi_preloads(preloads_lst, &preloads, dh)) <0) {
+	    do_build_load_error = 1;
+	    build_this_load_error = ERL_DE_FFI_PRELOADING_ERROR;
+	    goto soft_error;
+	} else {
+	    if (dh->preloads != NULL) {
+		/* We are rebuilding the preloads, free the old stuff */
+		erts_free(ERTS_ALC_T_DDLL_HANDLE, dh->preloads);
+	    }
+	    dh->npreloads = npreloads;
+	    dh->preloads = preloads;
+	}
+#else
+	do_build_load_error = 1;
+	build_this_load_error = ERL_DE_ERROR_NO_FFI_FUNCTIONALITY;
+	goto soft_error;
+#endif /* HAVE_LIBFFI */
+    }
 #if DDLL_SMP
     unlock_drv_list();
 #endif
@@ -753,6 +817,13 @@ Eterm erl_ddll_info_2(Process *p, Eterm 
     }
     
     switch (item) {
+    case am_preloads:
+#ifdef HAVE_LIBFFI
+	res = build_preloads_info(p, de->de_hndl);
+#else
+	res = NIL;
+#endif /* HAVE_LIBFFI */
+	goto done;
     case am_processes:
 	filter = ERL_DE_PROC_LOADED;
 	break;
@@ -1201,7 +1272,9 @@ static void ddll_no_more_references(void
 	DE_ProcEntry **p = &(dh->procs);
 	Eterm save_driver_name;
 	ASSERT(dh->status != ERL_DE_OK);
-	do_unload_driver_entry(dh,&save_driver_name);
+	do_unload_driver_entry(dh, &save_driver_name,
+			       dh->status == ERL_DE_RELOAD
+			       || dh->status == ERL_DE_FORCE_RELOAD);
 	while (*p != NULL) {
 	    DE_ProcEntry *q;
 	    if ((*p)->awaiting_status == ERL_DE_PROC_AWAIT_UNLOAD ||
@@ -1281,6 +1354,10 @@ char *erts_ddll_error(int code) {
 	return "Unspecified dynamic library error";
     case ERL_DE_LOOKUP_ERROR_NOT_FOUND:
 	return "Symbol not found in dynamic library";
+    case ERL_DE_FFI_PRELOADING_ERROR:
+	return "Could not preload symbols and/or compile FFI structures";
+    case ERL_DE_ERROR_NO_FFI_FUNCTIONALITY:
+	return "FFI functionality not available on this platform";
     default:
 	return erts_sys_ddll_error(code);
     }
@@ -1540,7 +1617,8 @@ static void set_driver_reloading(DE_Hand
     dh->reload_flags = flags;
 }
 
-static int do_load_driver_entry(DE_Handle *dh, char *path, char *name)
+static int do_load_driver_entry(DE_Handle *dh, char *path, char *name,
+				int need_driver_init)
 {
     void *init_handle;
     int res;
@@ -1552,16 +1630,41 @@ static int do_load_driver_entry(DE_Handl
 	return res;
     }
     
-    if ((res = erts_sys_ddll_load_driver_init(dh->handle, 
-					      &init_handle)) != ERL_DE_NO_ERROR) {
+    if ((res = erts_sys_ddll_load_driver_init(dh->handle,
+					      &init_handle)) == ERL_DE_NO_ERROR) {
+	dp = erts_sys_ddll_call_init(init_handle);
+	if (dp == NULL) {
+	    erts_sys_ddll_close(dh->handle);
+	    return ERL_DE_LOAD_ERROR_FAILED_INIT;
+	}
+
+	/* The driver entry is "genuine" and will not need to be freed */
+	dh->need_drventry_free = 0;
+    } else if (!need_driver_init) {
+	/* 
+	 * We weren't able to load the driver initialization function,
+	 * but we don't need it (since need_driver_init is false):
+	 * let's allocate a void ErlDrvEntry, that won't allow to use
+	 * erlang:port_control/3 and friends --- but will be OK for
+	 * the FFI interface
+	 */
+
+	/* FIXME: is this allocation type correct? */
+	dp = erts_alloc(ERTS_ALC_T_DRV, sizeof(ErlDrvEntry));
+	memset(dp, 0, sizeof(ErlDrvEntry));
+	dp->driver_name = erts_alloc(ERTS_ALC_T_DRV, sys_strlen(name) + 1);
+	strcpy(dp->driver_name, name);
+	dp->extended_marker = ERL_DRV_EXTENDED_MARKER;
+	dp->major_version = ERL_DRV_EXTENDED_MAJOR_VERSION;
+	dp->minor_version = ERL_DRV_EXTENDED_MINOR_VERSION;
+	
+	/* The driver entry will need to be freed */
+	dh->need_drventry_free = 1;
+    } else {
+	/* We require the driver init function, but we weren't able to
+	 * load it */
 	erts_sys_ddll_close(dh->handle);
 	return ERL_DE_LOAD_ERROR_NO_INIT;
-    }
-    
-    dp = erts_sys_ddll_call_init(init_handle);
-    if (dp == NULL) {
-	erts_sys_ddll_close(dh->handle);
-	return ERL_DE_LOAD_ERROR_FAILED_INIT;
     }
 
     switch (dp->extended_marker) {
@@ -1604,6 +1707,14 @@ static int do_load_driver_entry(DE_Handl
     sys_strcpy(dh->full_path, path);
     dh->flags = 0;
     dh->status = ERL_DE_OK;
+    dh->need_driver_init = need_driver_init;
+
+#ifdef HAVE_LIBFFI
+    /* FFI preloads will be set elsewhere */
+    dh->npreloads = 0;
+    dh->preloads = NULL;
+#endif /* HAVE_LIBFFI */
+
     dp->handle = dh;
 
     erts_add_driver_entry(dp,1); /* io.c */
@@ -1611,7 +1722,8 @@ static int do_load_driver_entry(DE_Handl
     return ERL_DE_NO_ERROR;
 }
 
-static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name)
+static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name,
+				  int keep_preloads)
 {
     DE_List *p = driver_list;
     DE_List *q;
@@ -1645,6 +1757,20 @@ static int do_unload_driver_entry(DE_Han
 		erts_free(ERTS_ALC_T_DRIVER_LOCK, q->driver_lock);
 	    }
 #endif
+	    if (dh->need_drventry_free) {
+		/* The ErlDrvEntry needs to be freed, probably because it
+		 * was autogenerated by do_load_driver_entry() */
+		erts_free(ERTS_ALC_T_DRV, q->drv->driver_name);
+		erts_free(ERTS_ALC_T_DRV, q->drv);
+	    }
+
+#ifdef HAVE_LIBFFI
+	    if (dh->preloads != NULL) {
+		if (!keep_preloads)
+		    erts_free(ERTS_ALC_T_DDLL_HANDLE, dh->preloads);
+	    }
+#endif /* HAVE_LIBFFI */
+
 	    erts_free(ERTS_ALC_T_DRV_ENTRY_LIST, (void *) q);
 	    return 1;
 	}
@@ -1653,7 +1779,8 @@ static int do_unload_driver_entry(DE_Han
     return 0;
 }
 
-static int load_driver_entry(DE_Handle **dhp, char *path, char *name)
+static int load_driver_entry(DE_Handle **dhp, char *path, char *name,
+			     int need_driver_init)
 {
     int res;
     DE_Handle *dh = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sizeof(DE_Handle));
@@ -1671,7 +1798,8 @@ static int load_driver_entry(DE_Handle *
     dh->full_path = NULL;
     dh->flags = 0;
 
-    if ((res = do_load_driver_entry(dh, path, name)) != ERL_DE_NO_ERROR) {
+    if ((res = do_load_driver_entry(dh, path, name,
+				    need_driver_init)) != ERL_DE_NO_ERROR) {
 	erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh);
 	dh = NULL;
     }
@@ -1682,7 +1810,7 @@ static int load_driver_entry(DE_Handle *
 #if 0
 static void unload_driver_entry(DE_Handle *dh)
 {
-    do_unload_driver_entry(dh, NULL);
+    do_unload_driver_entry(dh, NULL, 0);
     if (dh->full_path != NULL) {
 	erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path);
     }
@@ -1695,6 +1823,10 @@ static int reload_driver_entry(DE_Handle
     char *name = dh->reload_driver_name;
     int loadres;
     Uint flags = dh->reload_flags;
+#ifdef HAVE_LIBFFI
+    Uint npreloads = dh->npreloads;
+    FFIPreload *preloads = dh->preloads;
+#endif /* HAVE_LIBFFI */
 
     assert_drv_list_locked();
 
@@ -1706,12 +1838,21 @@ static int reload_driver_entry(DE_Handle
     erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path);
     dh->full_path = NULL;
 
-    loadres = do_load_driver_entry(dh, path, name);
+    loadres = do_load_driver_entry(dh, path, name, dh->need_driver_init);
     erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) path);
     erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) name);
     if (loadres == ERL_DE_NO_ERROR) {
 	dh->status = ERL_DE_OK;
 	dh->flags = flags;
+
+#ifdef HAVE_LIBFFI
+	if (preloads != NULL) {
+	    dh->npreloads = npreloads;
+	    dh->preloads = preloads;
+	    /* FFI symbols may have changed address, let's refresh them */
+	    refresh_ffi_preloads(dh);
+	}
+#endif /* HAVE_LIBFFI */
     }
     restore_process_references(dh);
     return loadres;
@@ -1797,6 +1938,7 @@ static ErrcodeEntry errcode_tab[] = {
     {"no_ddll_available",  ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY},
     {"unspecified_error", ERL_DE_ERROR_UNSPECIFIED},
     {"symbol_not_found", ERL_DE_LOOKUP_ERROR_NOT_FOUND},
+    {"ffi_preloading_error", ERL_DE_FFI_PRELOADING_ERROR},
     {NULL,0}
 };
 
@@ -1955,4 +2097,230 @@ static DE_List *lookup_driver(char *name
 	;
     return de;
 }
-    
+
+#ifdef HAVE_LIBFFI
+/*
+ * Build an array of preloaded and precompiled FFI call structures, to
+ * be written on **preloads.  Return the number of preloads, or a
+ * negative number (an FFI error status) on error.
+ */
+static int build_ffi_preloads(Eterm lst, FFIPreload **ret_preloads,
+			      DE_Handle *dh)
+{
+    Uint npreloads = 0, total_ftypes = 0, total_strlen = 0;
+    Uint i, nargs;
+    int status = 0;
+    FFIPreload *preloads = NULL;
+    Eterm l, tp, argstp, *tpval, *argstpval;
+    Eterm *signatures;
+    char *funcname = NULL, *fnames;
+    ffi_type **ftypes;
+    void *fptr;
+
+    assert_drv_list_locked();
+ 
+    /* We want one single allocation for all the preload data, so we
+     * need to count how many preloads and ffi_type's we are going to
+     * handle */
+    for(l = lst; is_list(l); l = CDR(list_val(l))) {
+	npreloads++;
+
+	tp = CAR(list_val(l));
+	if (is_not_tuple(tp))
+	    goto error;
+	tpval = tuple_val(tp);
+	if (*tpval != make_arityval(2))
+	    goto error;
+	argstp = tpval[2];
+	if (is_not_tuple(argstp))
+	    goto error;
+	argstpval = tuple_val(argstp);
+	if (is_not_arity_value(argstpval[0]))
+	    goto error;
+	nargs = arityval(argstpval[0]);
+	if (nargs == 0) {
+	    /* We need at least the return type of the function */
+	    goto error;
+	}
+	total_ftypes += nargs;
+
+	/* We also put the function names at the end of the allocated
+	 * memory block */
+	if ((funcname = pick_list_or_atom(tpval[1])) == NULL)
+	    goto error;
+	total_strlen += strlen(funcname);
+	erts_free(ERTS_ALC_T_DDLL_TMP_BUF, funcname);
+	funcname = NULL;
+    }
+
+    if (npreloads == 0)
+	return 0;
+
+    /* FIXME: is this allocation type correct? */
+    preloads = erts_alloc(ERTS_ALC_T_DDLL_HANDLE,
+			  (npreloads * sizeof(FFIPreload))
+			  + (total_ftypes * sizeof(ffi_type*))
+			  + (total_strlen + npreloads) /* For final \0's */
+			  + (total_ftypes * sizeof(Eterm))); /* Signature */
+    ftypes = (ffi_type**)(preloads + npreloads);
+    signatures = (Eterm*)(ftypes + total_ftypes);
+    fnames = (char*)(signatures + total_ftypes);
+
+    /* Let's actually build the FFI preloads */
+    for(l = lst, i = 0; is_list(l); l = CDR(list_val(l)), ++i, ftypes +=nargs){
+	/* We don't repeat the checks performed in the loop above */
+	tp = CAR(list_val(l));
+	tpval = tuple_val(tp);
+	argstp = tpval[2];
+	argstpval = tuple_val(argstp);
+	nargs = arityval(argstpval[0]);
+
+	if ((funcname = pick_list_or_atom(tpval[1])) == NULL)
+	    goto error;
+
+	if (erts_sys_ddll_sym(dh->handle, funcname, &fptr) != ERL_DE_NO_ERROR)
+	    goto error;
+	
+	preloads[i].name = strcpy(fnames, funcname);
+	fnames += strlen(funcname) + 1;
+	
+	preloads[i].function = fptr;
+	preloads[i].nargs = nargs;
+
+	preloads[i].signature = memcpy(signatures, argstpval+1,
+				       preloads[i].nargs * sizeof(Eterm));
+	signatures += nargs;
+
+	if ((status = erl_ffi_build_types_array(argstpval+1, ftypes,
+						preloads[i].nargs)))
+	    goto error;
+	preloads[i].ftypes = ftypes;
+
+        if (ffi_prep_cif(&preloads[i].cif, FFI_DEFAULT_ABI, nargs-1,
+                         ftypes[0], ftypes+1) != FFI_OK) {
+	    status = ERL_FFI_STATUS_FFI_ERROR;
+            goto error;
+	}
+
+	erts_free(ERTS_ALC_T_DDLL_TMP_BUF, funcname);
+	funcname = NULL;
+    }
+
+    *ret_preloads = preloads;
+    return npreloads;
+
+    error:
+    if (preloads != NULL)
+	erts_free(ERTS_ALC_T_DDLL_HANDLE, preloads);
+    if (funcname != NULL)
+	erts_free(ERTS_ALC_T_DDLL_TMP_BUF, funcname);
+    if (status == 0) {
+	/* Default error (if we are here, then something went wrong) */
+	return ERL_FFI_STATUS_BADARG;
+    }
+    return status;
+}
+
+/* Reload FFI symbols on the given FFIPreload structures, without
+ * touching the CIFs.  Missing function pointers will be set to NULL,
+ * and thus will not be callable anymore */
+static void refresh_ffi_preloads(DE_Handle *dh)
+{
+    FFIPreload *preloads = dh->preloads;
+    Uint npreloads = dh->npreloads;
+    Uint i;
+
+    assert_drv_list_locked();
+
+    if (dh->preloads == NULL)
+	return;
+
+    for (i = 0; i < npreloads; ++i) {
+	if (erts_sys_ddll_sym(dh->handle, preloads[i].name,
+			      &preloads[i].function) != ERL_DE_NO_ERROR) {
+	    preloads[i].function = NULL;
+	}
+    }
+}
+
+/* Build a term with information about the current preloads.  It will
+ * allocate a list of proplists (one for each FFI preload) */
+static Eterm build_preloads_info(Process *p, DE_Handle *dh)
+{
+    Eterm tmp, plist, res = NIL;
+    Eterm *hp;
+    Uint i;
+    int need = 0;
+    FFIPreload *preload;
+    Uint nargs;
+    Uint npreloads = (dh == NULL? 0 : dh->npreloads); /* Static driver? */
+    int len, fname_lengths[npreloads];
+
+    assert_drv_list_locked();
+
+    if (npreloads == 0) {
+	return NIL; /* The list of preloads is empty */
+    }
+
+    /* Compute the required memory, in order to perform only one allocation */
+    preload = dh->preloads;
+    for (i = 0; i < npreloads; ++i, ++preload) {
+	len = (int)sys_strlen(preload->name);
+	need += (2 /* cons the proplist on the main list */
+		 + (2 * 4) /* one cons * 4 proplist elements */
+		 + (3 * 4) /* one 2-tuple * 4 proplist elements */
+		 + (2 * (int)sys_strlen(preload->name)) /* func name */
+		 + (1 + WSIZE(sizeof(void*))) /* big int for func ptr */
+		 + (1 + preload->nargs)); /* tuple of FFI type atoms */
+	fname_lengths[i] = len;
+    }
+    hp = HAlloc(p, need);
+
+    /* Actually build the preloads information list, working in
+     * backward order. */
+    --preload; /* Let it point to the last preload */
+    for (i = npreloads; i != 0; --i, --preload) {
+	/* Function signature */
+	nargs = preload->nargs;
+	*(hp) = make_arityval(nargs);
+	tmp = make_tuple(hp);
+	++hp; /* Skip tuple head */
+	/* Copy the signature from the preload struct */
+	memcpy(hp, preload->signature, nargs * sizeof(Eterm));
+	hp += nargs;
+	tmp = TUPLE2(hp, am_signature, tmp);
+	hp += 3; /* Skip proplist tuple*/
+	plist = CONS(hp, tmp, NIL);
+	hp += 2; /* Skip proplist cons */
+
+	/* Function address */
+	tmp = bytes_to_big((byte*)&preload->function, sizeof(void*), 0, hp);
+	hp += 1 + WSIZE(sizeof(void*)); /* Skip big int */
+	tmp = TUPLE2(hp, am_address, tmp);
+	hp += 3; /* Skip proplist tuple*/
+	plist = CONS(hp, tmp, plist);
+	hp += 2; /* Skip proplist cons */
+
+	/* Function name */
+	tmp = buf_to_intlist(&hp, preload->name, fname_lengths[i-1], NIL);
+	tmp = TUPLE2(hp, am_name, tmp);
+	hp += 3; /* Skip proplist tuple*/
+	plist = CONS(hp, tmp, plist);
+	hp += 2; /* Skip proplist cons */
+
+	/* Function index */
+	tmp = make_small(i);
+	tmp = TUPLE2(hp, am_index, tmp);
+	hp += 3; /* Skip proplist tuple */
+	plist = CONS(hp, tmp, plist);
+	hp += 2; /* Skip proplist cons */
+
+	/* Finally cons the newly created proplist in the main list */
+	res = CONS(hp, plist, res);
+	/* Skip main list cons */
+	hp += 2;
+    }
+
+    return res;
+}
+#endif /* HAVE_LIBFFI */
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/erl_bif_ffi.c
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_ffi.c
@@ -0,0 +1,1028 @@
+/* ``The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved via the world wide web at http://www.erlang.org/.
+ * 
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ * 
+ * The Initial Developer of the Original Code is CRS4 - Center for
+ * Advanced Studies, Research and Development in Sardinia
+ * (http://www.crs4.it/). All Rights Reserved.''
+ * 
+ *     $Id$
+ */
+/* Foreign Function Interface (FFI) for Erlang/OTP
+ *
+ * Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+ * Author: Alceste Scalas <alceste@crs4.it>
+ */
+
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif
+
+#include <string.h>
+
+#include "sys.h"
+#include "erl_vm.h"
+#include "global.h"
+#include "erl_binary.h"
+#include "erl_process.h"
+#include "error.h"
+#include "bif.h"
+#include "atom.h"
+#include "big.h"
+#include "erl_bits.h"
+#include "erl_bif_ffi.h"
+
+#ifndef HAVE_LIBFFI
+
+/* 
+ * Since libffi is not supported, we always return an error when using
+ * one of the FFI BIFs
+ */
+BIF_RETTYPE ffi_raw_call_3(BIF_ALIST_3)
+{
+    /* FIXME: a more descriptive error is definitely required */
+    BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE ffi_raw_call_2(BIF_ALIST_2)
+{
+    /* FIXME: a more descriptive error is definitely required */
+    BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE ffi_raw_cstring_to_binary_1(BIF_ALIST_1)
+{
+    /* FIXME: a more descriptive error is definitely required */
+    BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE ffi_raw_buffer_to_binary_2(BIF_ALIST_2)
+{
+    /* FIXME: a more descriptive error is definitely required */
+    BIF_ERROR(BIF_P, BADARG);
+}
+
+#else /* HAVE_LIBFFI */
+
+#include "erl_bif_ffi_endianness.h"
+
+/*
+ * Some "special" types, that need particular care by the FFI.
+ * 
+ * We need a libffi type structure that is actually equal to
+ * ffi_type_pointer, but with a different address (later we will use
+ * 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;
+}
+
+/*
+ * FFI type conversion table
+ */
+typedef struct {
+    Eterm name;
+    ffi_type *ftype;
+} FFIConversion;
+
+static FFIConversion conversion_table[] = {
+    /* Standard C types.  Floating point and unsized types come first
+     * (it's some sort of optimization for frequent usages) */
+    {am_float, &ffi_type_float},
+    {am_double, &ffi_type_double},
+    {am_uint, &ffi_type_uint},
+    {am_sint, &ffi_type_sint},
+    {am_pointer, &ffi_type_pointer},
+    {am_cstring, &erl_ffi_type_cstring},
+    {am_nonnull, &erl_ffi_type_nonnull},
+    {am_ushort, &ffi_type_ushort},
+    {am_sshort, &ffi_type_sshort},
+    {am_ulong, &ffi_type_ulong},
+    {am_slong, &ffi_type_slong},
+    {am_uchar, &ffi_type_uchar},
+    {am_schar, &ffi_type_schar},
+    {am_void, &ffi_type_void},
+    {am_uint8, &ffi_type_uint8},
+    {am_sint8, &ffi_type_sint8},
+    {am_uint16, &ffi_type_uint16},
+    {am_sint16, &ffi_type_sint16},
+    {am_uint32, &ffi_type_uint32},
+    {am_sint32, &ffi_type_sint32},
+    {am_uint64, &ffi_type_uint64},
+    {am_sint64, &ffi_type_sint64},
+    {am_longdouble, &ffi_type_longdouble},
+
+     /* Other types derived from the standard ones. We could create
+      * new FFI types for size_t et al., but that's easier */
+    {am_size_t, ((sizeof(size_t) == sizeof(Uint32))
+                ? &ffi_type_uint32 : &ffi_type_uint64)},
+    {am_ssize_t, ((sizeof(ssize_t) == sizeof(Sint32))
+                 ? &ffi_type_sint32 : &ffi_type_sint64)},
+    {am_off_t, ((sizeof(off_t) == sizeof(Sint32))
+                ? &ffi_type_sint32 : &ffi_type_sint64)},
+    {am_pid_t, ((sizeof(pid_t) == sizeof(Sint32))
+		? &ffi_type_sint32 : &ffi_type_sint64)},
+
+    /* 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}
+};
+
+/*
+ * Forward declarations
+ */
+static int build_ffi_args_array(Eterm args[], ffi_type *ffi_types[], byte *buf,
+                                void *call_ptrs[], void *tmp_allocs[],
+				ErlDrvBinary *drv_allocs[], Uint n);
+static Eterm build_ffi_return_term(Process *p, ffi_type *rtype, byte *retval);
+static char *pick_list_or_atom(Eterm name_term);
+static Port *id_or_name2port(Process *c_p, Eterm id);
+Eterm erts_make_signed_integer(Sint x, Process *p);
+
+/*
+ * Call the given C function.  The function parameters are in the form:
+ *
+ *    Port, {Fn, Arg1, Arg2, ...}, {RetType, Arg1Type, Arg2Type, ...}
+ *
+ * where Port is an open port, Fn is an atom representing the function
+ * name, and Arg1... are the function arguments.  RetType is the C
+ * function return type, while Arg1Type...  are the C types of the
+ * function call arguments.
+ */
+BIF_RETTYPE ffi_raw_call_3(BIF_ALIST_3)
+{
+    Port* prt;
+    void* handle;
+    void* fptr;
+    Eterm *calltp, *typestp;
+    Uint nargs;
+    char *fname = NULL;
+    Eterm res;
+    int status = 0; /* Will possibly contain internal error codes */
+
+    prt = id_or_name2port(BIF_P, BIF_ARG_1);
+    if (!prt) {
+    error:
+        if (fname != NULL)
+            erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) fname);
+	if (prt)
+	    erts_smp_port_unlock(prt);
+        BIF_ERROR(BIF_P, BADARG);
+    }
+
+    if (is_not_tuple(BIF_ARG_2) || is_not_tuple(BIF_ARG_3))
+        goto error;
+    
+    calltp = tuple_val(BIF_ARG_2);
+    typestp = tuple_val(BIF_ARG_3);
+    /* The call and arguments tuples must have the same lengths */
+    if (calltp[0] != typestp[0])
+        goto error;
+    nargs = arityval(calltp[0]);
+    if (nargs < 1)
+	goto error;
+
+    /* Skip tuple lengths, we don't need them anymore */
+    ++typestp;
+    ++calltp;
+
+    /* FIXME: is the following check really necessary? */
+    if (!prt->drv_ptr)
+        goto error; /* The port is not associated to a driver */    
+    /* FIXME: is it possible that drv_ptr->handle is NULL? */
+    handle = ((DE_Handle*) prt->drv_ptr->handle)->handle;
+
+    /* Release the port lock as soon as possible, keeping its refcount
+     * (since the port is still in use, even if indirectly: we just
+     * need its driver handle) */
+    erts_smp_port_unlock_noderef(prt);
+
+    /* Extract function name from the first tuple element... */
+    if ((fname = pick_list_or_atom(calltp[0])) == NULL)
+        goto late_error;
+    /* ...and finally get function pointer */
+    if ((fptr = driver_dl_sym(handle, fname)) == NULL)
+        goto late_error;
+
+    {
+	Uint nargs_1 = nargs - 1;
+        Sint64 retval[2]; /* FFI return value (must be large & aligned) */
+        ffi_cif cif;
+        ffi_type* ftypes[nargs]; /* Return type + call arguments types */
+        void* avalues[nargs_1]; /* Pointers to arguments data */
+        void* tmp_allocs[nargs_1]; /* Buffers allocated with ERTS_ALC_T_TMP */
+        ErlDrvBinary* drv_allocs[nargs_1]; /* Driver bins that need free()d */
+        byte buf[ERL_FFI_ARGS_BUF_SIZE]; /* Buffer for FFI arguments */
+	ErlDrvBinary** b;
+	void** p;
+
+        /* Prepare the FFI function call... */
+        if ((status = erl_ffi_build_types_array(typestp, ftypes, nargs)))
+            goto late_error;
+        if ((status = build_ffi_args_array(calltp+1, ftypes+1, buf, avalues,
+                                           tmp_allocs, drv_allocs, nargs-1)))
+            goto late_error;
+
+        if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs_1,
+                         ftypes[0], ftypes+1) != FFI_OK) {
+	    status = ERL_FFI_STATUS_FFI_ERROR;
+            goto late_error;
+	}
+        /* ...and actually perform the call */
+        ffi_call(&cif, fptr, &retval, avalues);
+
+        /* Now figure out what to do with the return value */
+        res = build_ffi_return_term(BIF_P, ftypes[0], (byte*)retval);
+
+	/* Finally free the temporary data */
+	for (p = tmp_allocs; *p != NULL; ++p) {
+	    erts_free(ERTS_ALC_T_TMP, *p);
+	}
+	for (b = drv_allocs; *b != NULL; ++b) {
+	    /* We have created the binary for the sake of the FFI call, and we
+	     * are now removing our own reference.  If the called C function
+	     * didn't increase the refcount, the binary will be freed */
+	    driver_free_binary(*b);
+	}
+    }
+
+    /* "Fix" reference counting after the previous
+     * erts_smp_port_unlock_noderef() call */
+    erts_smp_port_deref(prt);
+    BIF_RET(res);
+
+    late_error:
+    erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) fname);
+    /* "Fix" reference counting after the previous
+     * erts_smp_port_unlock_noderef() call */
+    erts_smp_port_deref(prt);
+    switch (status) {
+    case 0:
+    case ERL_FFI_STATUS_BADARG:
+	BIF_ERROR(BIF_P, BADARG);
+    case ERL_FFI_STATUS_BUG:
+    case ERL_FFI_STATUS_FFI_ERROR:
+	BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+    case ERL_FFI_STATUS_TOO_MANY_ARGS:
+	BIF_ERROR(BIF_P, EXC_SYSTEM_LIMIT);
+    default:
+	/* It should never happen */
+	BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+    }
+}
+
+
+/*
+ * Call the given C function.  The function parameters are in the form:
+ *
+ *    Port, {FnIndex, Arg1, Arg2, ...}
+ *
+ * where Port is an open port (obtained from a driver/library loaded
+ * with erl_ddll:load_library/3), FnIndex is the function position in
+ * the preload list, and Arg1... are the function arguments.
+ */
+BIF_RETTYPE ffi_raw_call_2(BIF_ALIST_2)
+{
+    Port* prt;
+    DE_Handle* de_handle;
+    Uint npreloads;
+    FFIPreload* preload;
+    Uint nargs, func_idx;
+    Eterm* calltp;
+    Eterm res;
+    int status = 0; /* Will possibly contain internal error codes */
+
+    prt = id_or_name2port(BIF_P, BIF_ARG_1);
+    if (!prt) {
+    error:
+	if (prt)
+	    erts_smp_port_unlock(prt);
+        BIF_ERROR(BIF_P, BADARG);
+    }
+
+    if (is_not_tuple(BIF_ARG_2))
+        goto error;
+    calltp = tuple_val(BIF_ARG_2);
+    nargs = arityval(calltp[0]);
+    if (nargs < 1)
+	goto error;
+    if (is_not_small(calltp[1]))
+	goto error;
+    func_idx = unsigned_val(calltp[1]);
+
+    /* Skip tuple length, we don't need them anymore */
+    ++calltp;
+    
+    /* FIXME: is the following check really necessary? */
+    if (!prt->drv_ptr)
+        goto error; /* The port is not associated to a driver */    
+    de_handle = (DE_Handle*) prt->drv_ptr->handle;
+
+    /* Release the port lock as soon as possible, keeping its refcount
+     * (since it's still in use, even if indirectly - we just need its
+     * driver handle) */
+    erts_smp_port_unlock_noderef(prt);
+
+    npreloads = de_handle->npreloads;
+
+    /* Is the given function index within bounds? */
+    if ((func_idx > npreloads) || (func_idx == 0))
+	goto late_error;
+
+    preload = de_handle->preloads + (func_idx - 1);
+
+    /* The selected function may have been disabled, e.g. if the
+     * library was reloaded and the symbol disappeared */
+    if (preload->function == NULL)
+	goto late_error;
+
+    /* Is the function call arity compatible with the precompiled FFI
+     * signature? */
+    if (nargs != preload->nargs)
+	goto late_error;
+
+    {
+	Uint nargs_1 = nargs - 1;
+        Sint64 retval[2]; /* FFI return value (must be large & aligned) */
+        void* avalues[nargs_1]; /* Pointers to arguments data */
+        void* tmp_allocs[2*nargs_1]; /* Buffers allocated with ERTS_ALC_T_TMP */
+        ErlDrvBinary* drv_allocs[nargs_1]; /* Driver bins that need free()d */
+        byte buf[ERL_FFI_ARGS_BUF_SIZE]; /* Buffer for FFI arguments */
+	ErlDrvBinary** b;
+	void** p;
+
+        /* Prepare the FFI function call... */
+        if ((status = build_ffi_args_array(calltp+1,
+					   preload->ftypes + 1, buf, avalues,
+					   tmp_allocs, drv_allocs, nargs_1)))
+            goto late_error;
+        /* ...and actually perform the call */
+        ffi_call(&preload->cif, preload->function, &retval, avalues);
+
+        /* Now figure out what to do with the return value */
+        res = build_ffi_return_term(BIF_P, preload->ftypes[0], (byte*)retval);
+
+	/* Finally free the temporary data */
+	for (p = tmp_allocs; *p != NULL; ++p) {
+	    erts_free(ERTS_ALC_T_TMP, *p);
+	}
+	for (b = drv_allocs; *b != NULL; ++b) {
+	    /* We have created the binary for the sake of the FFI
+	     * call, and we are now removing our own reference.  If
+	     * the called C function didn't increase the refcount, or
+	     * didn't return it, the binary will be freed */
+	    driver_free_binary(*b);
+	}
+    }
+
+    /* "Fix" reference counting after the previous
+     * erts_smp_port_unlock_noderef() call */
+    erts_smp_port_deref(prt);
+    BIF_RET(res);
+
+    late_error:
+    /* "Fix" reference counting after the previous
+     * erts_smp_port_unlock_noderef() call */
+    erts_smp_port_deref(prt);
+    switch (status) {
+    case 0:
+    case ERL_FFI_STATUS_BADARG:
+	BIF_ERROR(BIF_P, BADARG);
+    case ERL_FFI_STATUS_BUG:
+    case ERL_FFI_STATUS_FFI_ERROR:
+	BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+    case ERL_FFI_STATUS_TOO_MANY_ARGS:
+	BIF_ERROR(BIF_P, EXC_SYSTEM_LIMIT);
+    default:
+	/* It should never happen */
+	BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+    }
+}
+
+/* Return a new binary with a copy of the given NULL-terminated string
+ * (a pointer possibly obtained with a FFI call) */
+BIF_RETTYPE ffi_raw_cstring_to_binary_1(BIF_ALIST_1)
+{
+    char* ptr;
+    Eterm res;
+
+    if (is_big(BIF_ARG_1)) {
+	FFI_BIG_TO_UNSIGNED_NATIVE(&ptr, BIF_ARG_1, char*);
+    } else if (is_small(BIF_ARG_1)) {
+	ptr = (char*)unsigned_val(BIF_ARG_1);
+    } else {
+    error:
+	BIF_ERROR(BIF_P, BADARG);
+    }
+    
+    if (ptr == NULL)
+	goto error;
+
+    res = new_binary(BIF_P, (byte*)ptr, sys_strlen(ptr) + 1); /* Include '\0'*/
+
+    BIF_RET(res);
+}
+
+/* Return a new binary with a copy of BIF_ARG_2 bytes from the given
+ * buffer (a pointer possibly obtained with a FFI call) */
+BIF_RETTYPE ffi_raw_buffer_to_binary_2(BIF_ALIST_2)
+{
+    byte* ptr;
+    int size;
+    Eterm res;
+
+    if (is_big(BIF_ARG_1)) {
+	FFI_BIG_TO_UNSIGNED_NATIVE(&ptr, BIF_ARG_1, byte*);
+    } else if (is_small(BIF_ARG_1)) {
+	ptr = (byte*)unsigned_val(BIF_ARG_1);
+    } else {
+    error:
+	BIF_ERROR(BIF_P, BADARG);
+    }
+    
+    if (ptr == NULL)
+	goto error;
+
+    if (is_not_small(BIF_ARG_2))
+	BIF_ERROR(BIF_P, BADARG);
+    size = (int)unsigned_val(BIF_ARG_2);
+
+    res = new_binary(BIF_P, ptr, size);
+
+    BIF_RET(res);
+}
+
+/* Fill the given array of ffi_type pointers with proper values, based
+ * on the given array of Erlang terms.  'n' is the number of elements
+ * of the arrays.  Return 0 on success, something else on error. */
+int erl_ffi_build_types_array(Eterm types[], ffi_type *ftypes[], Uint n)
+{
+    Uint i;
+    Eterm tname;
+    FFIConversion *conv;
+
+    for (i = 0; i < n; ++i) {
+        tname = types[i];
+
+        if (is_not_atom(tname))
+            return ERL_FFI_STATUS_BADARG;
+
+        for (conv = conversion_table; conv->name != am_false; ++conv) {
+            if (conv->name == tname) {
+                ftypes[i] = conv->ftype;
+                break;
+            }
+        }
+        if (conv->name == am_false) {
+            /* Type was invalid */
+            return ERL_FFI_STATUS_BADARG;
+        }
+    }
+
+    return ERL_FFI_STATUS_OK;
+}
+
+/* Fill 'call_ptrs' with proper pointers, based on the given array of
+ * Erlang terms representing FFI call arguments.  'n' is the number of
+ * elements of the arrays.  'buf' is used as storage for data that
+ * needs to be copied.
+ *
+ * 'tmp_allocs' and 'drv_allocs' are NULL-terminated array of pointers
+ * to (respectively) temporary buffers (ERTS_ALC_T_TMP) and
+ * ErlDrvBinary's that should be freed after the function returns.
+ * Their size should be at least n, or (3*n) in the case of
+ * 'tmp_allocs'.
+ *
+ * Return 0 on success, something else on error. */
+static int build_ffi_args_array(Eterm args[], ffi_type *ffi_types[], byte *buf,
+				void *call_ptrs[], void *tmp_allocs[],
+				ErlDrvBinary *drv_allocs[], Uint n)
+{
+    Uint i, offset = 0;
+    FloatDef f;
+    ffi_type* ftype;
+    Eterm arg, bitoffs, bitsize;
+    Eterm *binval;
+    const byte* ptr;
+    Binary *bin;
+    ErlDrvBinary *drvbin;
+
+    /* Mark the end of the allocations arrays (it will be moved at
+     * each actual allocation */
+    *tmp_allocs = NULL;
+    *drv_allocs = NULL;
+
+    for (i = 0; i < n; ++i) {
+        
+        if (offset > ERL_FFI_ARGS_BUF_SIZE)
+            return ERL_FFI_STATUS_TOO_MANY_ARGS;
+
+        ftype = ffi_types[i];
+        arg = args[i];
+        if (ftype == &ffi_type_float) {
+            if (is_not_float(arg))
+                return -1;
+            GET_DOUBLE(arg, f);
+            *((float*)buf) = (float)f.fd;
+            call_ptrs[i] = buf;
+            offset += sizeof(float);
+            buf += sizeof(float);
+        } else if (ftype == &ffi_type_double) {
+            if (is_not_float(arg))
+                return ERL_FFI_STATUS_BADARG;
+            GET_DOUBLE(arg, f);
+            *((double*)buf) = f.fd;
+            call_ptrs[i] = buf;
+            offset += sizeof(double);
+            buf += sizeof(double);
+        } else if (ftype == &ffi_type_uint) {
+            /* Integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, unsigned int);
+            } else if (is_small(arg))
+                *((unsigned int*) buf) = unsigned_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(unsigned int);
+            buf += sizeof(unsigned int);
+        } else if (ftype == &ffi_type_sint) {
+            /* Integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, unsigned int);
+                if (big_sign(arg)) {
+                    /* Erlang big integers keep a sign byte, instead of using
+                     * 2's complement */
+		    *(int*)buf = -(*(unsigned int*)buf);
+                }
+            } else if (is_small(arg))
+                *((int*) buf) = signed_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(int);
+            buf += sizeof(int);
+        } else if (ftype == &ffi_type_pointer
+		   || ftype == &erl_ffi_type_cstring
+		   || ftype == &erl_ffi_type_nonnull) {
+            /* Pointers may be taken either from binaries, smalls or bigs */
+            if (is_binary(arg)) {
+                ERTS_GET_BINARY_BYTES(arg, ptr, bitoffs, bitsize);
+		*(const byte**)buf = ptr;
+            } else if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, byte*);
+            } else if (is_small(arg)) {
+		*((byte**)buf) = (byte*)unsigned_val(arg);
+            } else
+                return ERL_FFI_STATUS_BADARG;
+	    if ((ftype != &ffi_type_pointer) && (*(byte**)buf == NULL)) {
+		/* 'cstring' and 'nonnull' may not be NULL */
+		return ERL_FFI_STATUS_BADARG;
+	    }
+            call_ptrs[i] = buf;
+            offset += sizeof(byte*);
+            buf += sizeof(byte*);
+        } else if (ftype == &ffi_type_ushort) {
+            if (is_not_small(arg))
+                return ERL_FFI_STATUS_BADARG;
+            *((unsigned short*)buf) = (unsigned short)unsigned_val(arg);
+            call_ptrs[i] = buf;
+            offset += sizeof(unsigned short);
+            buf += sizeof(unsigned short);
+        } else if (ftype == &ffi_type_sshort) {
+            if (is_not_small(arg))
+                return ERL_FFI_STATUS_BADARG;
+            *((short*)buf) = (short)signed_val(arg);
+            call_ptrs[i] = buf;
+            offset += sizeof(short);
+            buf += sizeof(short);
+        } else if (ftype == &ffi_type_ulong) {
+            /* Long integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, unsigned long);
+            } else if (is_small(arg))
+                *((unsigned long*) buf) = unsigned_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(unsigned long);
+            buf += sizeof(unsigned long);
+        } else if (ftype == &ffi_type_slong) {
+            /* Integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, unsigned long);
+                if (big_sign(arg)) {
+                    /* Erlang big integers keep a sign byte, instead of using
+                     * 2's complement */
+		    *(long*)buf = -(*(unsigned long*)buf);
+                }
+            } else if (is_small(arg))
+                *((long*) buf) = signed_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(long);
+            buf += sizeof(long);
+        } else if (ftype == &ffi_type_uchar) {
+            /* This also applies for uint8 */
+            if (is_not_small(arg))
+                return ERL_FFI_STATUS_BADARG;
+            *((unsigned char*)buf) = unsigned_val(arg);
+            call_ptrs[i] = buf;
+            offset += sizeof(unsigned char);
+            buf += sizeof(unsigned char);
+        } else if (ftype == &ffi_type_schar) {
+            /* This also applies for sint8 */
+            if (is_not_small(arg))
+                return ERL_FFI_STATUS_BADARG;
+            *((char*)buf) = signed_val(arg);
+            call_ptrs[i] = buf;
+            offset += sizeof(char);
+            buf += sizeof(char);
+        } else if (ftype == &ffi_type_uint16) {
+            if (is_not_small(arg))
+                return ERL_FFI_STATUS_BADARG;
+            *((Uint16*)buf) = (Uint16)unsigned_val(arg);
+            call_ptrs[i] = buf;
+            offset += sizeof(Uint16);
+            buf += sizeof(Uint16);
+        } else if (ftype == &ffi_type_sint16) {
+            if (is_not_small(arg))
+                return ERL_FFI_STATUS_BADARG;
+            *((Sint16*)buf) = (Sint16)signed_val(arg);
+            call_ptrs[i] = buf;
+            offset += sizeof(Sint16);
+            buf += sizeof(Sint16);
+        } else if (ftype == &ffi_type_uint32) {
+            /* 32-bit integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, Uint32);
+            } else if (is_small(arg))
+                *((Uint32*) buf) = (Uint32)unsigned_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(Uint32);
+            buf += sizeof(Uint32);
+        } else if (ftype == &ffi_type_sint32) {
+            /* 32-bit integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, Uint32);
+                if (big_sign(arg)) {
+                    /* Erlang big integers keep a sign byte, instead of using
+                     * 2's complement */
+		    *(Sint32*)buf = -(*(Uint32*)buf);
+                }
+            } else if (is_small(arg))
+                *((Sint32*) buf) = signed_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(Sint32);
+            buf += sizeof(Sint32);
+        } else if (ftype == &ffi_type_uint64) {
+            /* 64-bit integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, Uint64);
+            } else if (is_small(arg)) {
+                *((Uint64*) buf) = unsigned_val(arg);
+            } else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(Uint64);
+            buf += sizeof(Uint64);
+        } else if (ftype == &ffi_type_sint64) {
+            /* Integers may be taken either from smalls or bigs */
+            if (is_big(arg)) {
+		FFI_BIG_TO_UNSIGNED_NATIVE(buf, arg, Uint64);
+                if (big_sign(arg)) {
+                    /* Erlang big integers keep a sign byte, instead of using
+                     * 2's complement */
+		    *((Sint64*) buf) = -(*(Uint64*)buf);
+                }
+            } else if (is_small(arg))
+                *((Sint64*) buf) = signed_val(arg);
+            else
+                return ERL_FFI_STATUS_BADARG;
+            call_ptrs[i] = buf;
+            offset += sizeof(Sint64);
+            buf += sizeof(Sint64);
+        } else if (ftype == &ffi_type_longdouble) {
+            if (is_not_float(arg))
+                return ERL_FFI_STATUS_BADARG;
+            GET_DOUBLE(arg, f);
+            *((long double*)buf) = (long double)f.fd;
+            call_ptrs[i] = buf;
+            offset += sizeof(long double);
+            buf += sizeof(long double);
+	} else if (ftype == &erl_ffi_type_binary) {
+            if (is_not_binary(arg))
+                return ERL_FFI_STATUS_BADARG;
+
+	    ERTS_GET_BINARY_BYTES(arg, ptr, bitoffs, bitsize);
+	    binval = binary_val(arg);	    
+	    if ((thing_subtag(*binval) == HEAP_BINARY_SUBTAG)
+		|| (thing_subtag(*binval) == SUB_BINARY_SUBTAG)) {
+		/* We need to create a new refcounted binary with the
+		 * original contents */
+		bin = erts_bin_drv_alloc_fnf(binary_size(arg));
+		if (bin == NULL) {
+		    erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY,
+				      sizeof(Binary) + binary_size(arg));
+		}
+		bin->flags = BIN_FLAG_DRV;
+		erts_refc_init(&bin->refc, 1);
+		bin->orig_size = (long) binary_size(arg);
+		sys_memcpy(bin->orig_bytes, ptr, bin->orig_size);
+
+		/* Mark the new binary to be freed */
+		*drv_allocs = Binary2ErlDrvBinary(bin);
+		*(++drv_allocs) = NULL;
+	    } else {
+		/* This is a refcounted binary, we just use it
+		 * directly */
+		bin = ((ProcBin*) binval)->val;
+	    }
+	    /* Turn the binary into an ErlDrvBinary and use it */
+	    drvbin = Binary2ErlDrvBinary(bin);
+            *((ErlDrvBinary**)buf) = drvbin;
+            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;
+        }
+    }
+
+    return ERL_FFI_STATUS_OK;
+}
+
+/* Build an Erlang Term compatible with the given FFI return type and
+ * value. */
+static Eterm build_ffi_return_term(Process* p, ffi_type* rtype, byte* retval)
+{
+    FloatDef f;
+    Eterm res;
+    Eterm* hp;
+    ProcBin *pb;
+    Binary *bin;
+    byte *ptr;
+
+    if (rtype == &ffi_type_void) {
+        return am_void;
+    } else if (rtype == &ffi_type_float) {
+        f.fd = *((float*) retval);
+        hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+        res = make_float(hp);
+        PUT_DOUBLE(f, hp);
+    } else if (rtype == &ffi_type_double) {
+        f.fd = *((double*) retval);
+        hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+        res = make_float(hp);
+        PUT_DOUBLE(f, hp);
+    } else if (rtype == &ffi_type_uint) {
+        res = erts_make_integer(FFI_BUF_VALUE(retval, unsigned int,
+					      unsigned int), p);
+    } else if (rtype == &ffi_type_sint) {
+        res = erts_make_signed_integer(FFI_BUF_VALUE(retval, int, int), p);
+    } else if (rtype == &ffi_type_pointer
+	       || rtype == &erl_ffi_type_cstring
+	       || rtype == &erl_ffi_type_nonnull) {
+	if ((rtype != &ffi_type_pointer)
+	    && (FFI_BUF_VALUE(retval, void*, void*)) == NULL) {
+	    /* 'cstring' and 'nonnull' may not be NULL */
+	    /* FIXME: a more descriptive error is definitely needed */
+	    BIF_ERROR(p, BADARG);
+	}
+	/* A pointer has the size of a word, and alwais fits in a Uint */
+	res = erts_make_integer(FFI_BUF_VALUE(retval, Uint, Uint), p);
+    } else if (rtype == &ffi_type_ushort) {
+        res = FFI_NATIVE_TO_SMALL(retval, unsigned short, unsigned short);
+    } else if (rtype == &ffi_type_sshort) {
+	res = FFI_NATIVE_TO_SMALL(retval, short, short);
+    } else if (rtype == &ffi_type_ulong) {
+	if (FFI_BUF_IS_USMALL(retval, unsigned long)) {
+	    res = FFI_NATIVE_TO_SMALL(retval, unsigned long, Uint);
+	} else {
+	    res = FFI_UNSIGNED_NATIVE_TO_BIG(p, retval, unsigned long, 0);
+	}
+    } else if (rtype == &ffi_type_slong) {
+	if (FFI_BUF_IS_SSMALL(retval, long)) {
+	    res = FFI_NATIVE_TO_SMALL(retval, long, Sint);
+	} else {
+	    if (FFI_BUF_SIGN(retval, long, long)) {
+		FFI_CHANGE_BUF_SIGN(retval, long, long, unsigned long);
+		res = FFI_UNSIGNED_NATIVE_TO_BIG(p, retval, unsigned long, 1);
+	    } else {
+		res = FFI_UNSIGNED_NATIVE_TO_BIG(p, retval, unsigned long, 0);
+	    }
+        }
+    } else if (rtype == &ffi_type_uchar) {
+        /* It also applies for uint8 */
+	res = FFI_NATIVE_TO_SMALL(retval, unsigned char, unsigned char);
+    } else if (rtype == &ffi_type_schar) {
+        /* It also applies for sint8 */
+	res = FFI_NATIVE_TO_SMALL(retval, signed char, signed char);
+    } else if (rtype == &ffi_type_uint16) {
+	res = FFI_NATIVE_TO_SMALL(retval, Uint16, Uint16);
+    } else if (rtype == &ffi_type_sint16) {
+	res = FFI_NATIVE_TO_SMALL(retval, Sint16, Sint16);
+    } else if (rtype == &ffi_type_uint32) {
+        res = erts_make_integer(FFI_BUF_VALUE(retval, Uint32, Uint32), p);
+    } else if (rtype == &ffi_type_sint32) {
+        res = erts_make_signed_integer(FFI_BUF_VALUE(retval, Uint32, Uint32),
+				       p);
+    } else if (rtype == &ffi_type_uint64) {
+	if (FFI_BUF_IS_USMALL(retval, Uint64)) {
+	    res = FFI_NATIVE_TO_SMALL(retval, Uint64, Uint);
+	} else {
+	    res = FFI_UNSIGNED_NATIVE_TO_BIG(p, retval, Uint64, 0);
+	}
+    } else if (rtype == &ffi_type_sint64) {
+	if (FFI_BUF_IS_SSMALL(retval, Sint64)) {
+	    res = FFI_NATIVE_TO_SMALL(retval, Sint64, Uint);
+	} else {
+	    if (FFI_BUF_SIGN(retval, Sint64, Sint64)) {
+		FFI_CHANGE_BUF_SIGN(retval, Sint64, Sint64, Uint64);
+		res = FFI_UNSIGNED_NATIVE_TO_BIG(p, retval, Uint64, 1);
+	    } else {
+		res = FFI_UNSIGNED_NATIVE_TO_BIG(p, retval, Uint64, 0);
+	    }
+	}
+    } else if (rtype == &ffi_type_longdouble) {
+        /* Sorry, we must truncate the long double into a double */
+        f.fd = *((long double*) retval);
+        hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+        res = make_float(hp);
+        PUT_DOUBLE(f, hp);
+    } else if (rtype == &erl_ffi_type_binary) {
+	/* FIXME: check that the handling of returned binaries is OK
+	 *
+	 * More in detail, there are three cases (always requiring a
+	 * refcount increment):
+	 *
+	 *   1. the returned driver binary may have been autogenerated
+	 *      by the FFI (and it is, thus, pointed in the 'drv_allocs'
+	 *      array), and used as C function call argument.  We must
+	 *      increase its refcount, in order to prevent its
+	 *      deallocation (because when we return, a
+	 *      driver_free_binary() will be issued);
+	 *
+	 *   2. the driver binary may have been originated by the
+	 *      Erlang VM, passed as C function call argument, and
+	 *      returned.  Now it is possibly going to be bound to a
+	 *      (new?) variable.  Should we increase its refcount?
+	 *      Yes (but deeper review is required);
+	 *
+	 *   3. the driver binary was created by the C side.  If the
+	 *      developer followed the rules about refcount
+	 *      management, everything is OK and we can increase the
+	 *      refcount.  In this case the original refcount could be
+	 *      0 (if the calling function didn't want to track the
+	 *      binary after return, thus calling
+	 *      driver_binary_dec_refc()).
+	 */
+	ptr = *((byte**)retval);
+	if (ptr == NULL) {
+	    /* A binary may not be NULL */
+	    /* FIXME: a more descriptive error is definitely needed */
+	    BIF_ERROR(p, BADARG);
+	}
+	bin = ErlDrvBinary2Binary((ErlDrvBinary*) ptr);
+	erts_refc_inc(&bin->refc, 1);
+
+	pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE);	
+	pb->thing_word = HEADER_PROC_BIN;
+	pb->size = bin->orig_size;
+	pb->next = MSO(p).mso;
+	MSO(p).mso = pb;
+	pb->val = bin;
+	pb->bytes = (byte*) bin->orig_bytes;
+	MSO(p).overhead += (bin->orig_size / BINARY_OVERHEAD_FACTOR
+			    / sizeof(Eterm));
+	res = make_binary(pb);
+    } else {
+        /* It should never happen */
+        BIF_ERROR(p, EXC_INTERNAL_ERROR);
+    }
+
+    return res;
+}
+
+/* FIXME: this is duplicated from erl_bif_ddll.c
+ *
+ * Anyway, the duplication allows to easily spot what kind of
+ * erts_free() is needed for freeing the returned buffer.
+ */
+static char *pick_list_or_atom(Eterm name_term)
+{ 
+    char *name = NULL;
+    int name_len;
+    if (is_atom(name_term)) {
+        Atom *ap = atom_tab(atom_val(name_term));
+        if (ap->len == 0) {
+            /* If io_lists with zero length is not allowed, 
+               then the empty atom shouldn't */
+            goto error;
+        }
+        name = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, ap->len + 1);
+        memcpy(name,ap->name,ap->len);
+        name[ap->len] = '\0';
+    } else {
+        name_len = io_list_len(name_term);
+        if (name_len <= 0) {
+            goto error;
+        }
+        name = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, name_len + 1);
+        if (io_list_to_buf(name_term, name, name_len) != 0) {
+            goto error;
+        }
+        name[name_len] = '\0';
+    }
+    return name;
+ error:
+    if (name != NULL) {
+        erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name);
+    }
+    return NULL;
+}
+
+/* FIXME: this is duplicated from erl_bif_port.c */
+static Port*
+id_or_name2port(Process *c_p, Eterm id)
+{
+    Port *port;
+    if (is_not_atom(id))
+        port = erts_id2port(id, c_p, ERTS_PROC_LOCK_MAIN);
+    else
+        erts_whereis_name(c_p, ERTS_PROC_LOCK_MAIN, id, NULL, 0, 0, &port);
+    return port;
+}
+
+/*
+** Create bigint on heap if necessary. Like the previously existing
+** make_small_or_big(), except for a HAlloc() instead of an
+** ArithAlloc().
+** NOTE: Only use erts_make_signed_integer(), when order of heap fragments is
+**       guaranteed to be correct.
+**
+* FIXME: it's almost duplicated from erts_make_integer in big.c
+*/
+Eterm
+erts_make_signed_integer(Sint x, Process *p)
+{
+    Eterm* hp;
+    if (IS_SSMALL(x))
+        return make_small(x);
+    else {
+        hp = HAlloc(p, BIG_UINT_HEAP_SIZE);
+        return small_to_big(x,hp);
+    }
+}
+
+#endif /* HAVE_LIBFFI */
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/erl_bif_ffi.h
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_ffi.h
@@ -0,0 +1,50 @@
+/* ``The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved via the world wide web at http://www.erlang.org/.
+ * 
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ * 
+ * The Initial Developer of the Original Code is CRS4
+ * (http://www.crs4.it/). All Rights Reserved.''
+ * 
+ *     $Id$
+ */
+/* Foreign Function Interface (FFI) for Erlang/OTP
+ *
+ * Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+ * Author: Alceste Scalas <alceste@crs4.it>
+ */
+
+#ifndef __ERL_BIF_FFI_H__
+#define __ERL_BIF_FFI_H__
+
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif
+
+/* Buffer size used for storing FFI call arguments */
+#define ERL_FFI_ARGS_BUF_SIZE 512
+
+/* Some internal error statuses returned by FFI routines  */
+#define ERL_FFI_STATUS_OK            0
+#define ERL_FFI_STATUS_BADARG        -1
+#define ERL_FFI_STATUS_TOO_MANY_ARGS -2
+#define ERL_FFI_STATUS_FFI_ERROR     -3
+#define ERL_FFI_STATUS_BUG           -99
+
+#ifdef HAVE_LIBFFI
+
+#include <ffi.h>
+
+/* Function prototypes */
+void erts_init_ffi(void);
+int erl_ffi_build_types_array(Eterm types[], ffi_type *ftypes[],Uint n);
+
+#endif /* HAVE_LIBFFI */
+
+#endif /* __ERL_BIF_FFI_H__ */
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/erl_bif_ffi_endianness.h
--- /dev/null
+++ b/erts/emulator/beam/erl_bif_ffi_endianness.h
@@ -0,0 +1,223 @@
+/* ``The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved via the world wide web at http://www.erlang.org/.
+ * 
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ * 
+ * The Initial Developer of the Original Code is CRS4 - Center for
+ * Advanced Studies, Research and Development in Sardinia
+ * (http://www.crs4.it/). All Rights Reserved.''
+ * 
+ *     $Id$
+ */
+/* Foreign Function Interface (FFI) for Erlang/OTP
+ *
+ * Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+ * Author: Alceste Scalas <alceste@crs4.it>
+ */
+
+#ifndef __ERL_BIF_FFI_ENDIANNESS_H__
+#define __ERL_BIF_FFI_ENDIANNESS_H__
+
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif
+
+#ifdef HAVE_LIBFFI
+
+#include "erl_term.h"
+#include "sys.h"
+#include "big.h"
+
+/* 
+ * Helper macros for dealing with endianness FFI buffers.
+ *
+ * Only macros with the FFI_ prefix should be used outside of this
+ * file (see below).
+ *
+ * NOTE: here we use Uint assuming that it is a word-sized type.
+ */
+
+#define ERL_FFI_WORD_MASK (~((Uint)0))
+
+#if WORDS_BIGENDIAN
+/******************************************************************************
+ * BIGENDIAN PLATFORMS
+ *****************************************************************************/
+
+/* Given a word-aligned buffer large enough to contain a value of type
+ * ORIGTYPE, return the number of unused bytes (from the beginning of
+ * the buffer) that must be discarded when the buffer contents are
+ * casted to CTYPE */
+#define SUBVAL_OFFSET(ORIGTYPE, CTYPE)					\
+    ((sizeof(CTYPE) <= sizeof(ORIGTYPE))				\
+     ? ((sizeof(ORIGTYPE) > sizeof(Uint))				\
+	? (sizeof(ORIGTYPE) - sizeof(CTYPE))				\
+	: (sizeof(Uint) - sizeof(CTYPE)))				\
+     : 0)
+
+/* Copy a native buffer into a little-endian one, or vice versa */
+static inline void _copy_swap_native_le(byte *dest, const byte *src,
+					unsigned int size)
+{
+    unsigned int i = 0;
+
+    dest += size - 1;
+    for (; i < size; ++i) {
+	*dest-- = *src++;
+    }    
+}
+
+/* Copy the given number of bytes from an Erlang big integer to a
+ * native-endianness buffer. */
+static inline void _big_to_unsigned_native(byte *dest, Eterm big,
+					   unsigned int size) 
+{
+    byte buf[size];
+    unsigned int big_bytes = big_size(big) * sizeof(digit_t);
+    unsigned int pad = ((big_bytes < size)
+			? (size - big_bytes)
+			: 0);
+    
+    big_to_bytes(big, buf); 
+    /* Pad if the big size is lesser than the target type size */
+    _copy_swap_native_le(dest + pad, buf, size - pad);
+
+    /* Fill the padding (i.e. the MSBs) with 0 */
+    if (pad) {
+	memset(dest, 0, pad);
+    }
+}
+
+/* Copy a value of the given type from an Erlang big integer to a
+ * native-endianness buffer.  NOTE: the big sign will be ignored */
+#define FFI_BIG_TO_UNSIGNED_NATIVE(DEST, ETERM, CTYPE) \
+    _big_to_unsigned_native(((byte*)(DEST)), (ETERM), sizeof(CTYPE))
+
+#else /* !WORDS_BIGENDIAN */
+/******************************************************************************
+ * LITTLE-ENDIAN PLATFORMS
+ *****************************************************************************/
+
+#define SUBVAL_OFFSET(ORIGTYPE, CTYPE) 0
+
+/* Since we know that big integer bytes are still properly aligned on
+ * little-endian platforms, we can save a big_to_bytes() call */
+#define FFI_BIG_TO_UNSIGNED_NATIVE(DEST, ETERM, CTYPE)			\
+    {									\
+	*(CTYPE*)(DEST) = (CTYPE)0;					\
+	if ((big_size(ETERM) * sizeof(digit_t)) < sizeof(CTYPE)) {	\
+	    memcpy((DEST), big_v(ETERM), big_size(ETERM) * sizeof(digit_t)); \
+	} else {							\
+	    *(CTYPE*)(DEST) = *(CTYPE*)big_v(ETERM);			\
+	}								\
+    }
+
+#endif /* !WORDS_BIGENDIAN */
+
+/******************************************************************************
+ * ALMOST ENDIANNESS-INDEPENDANT MACROS
+ *****************************************************************************/
+
+/* Get the value of type CTYPE stored in a buffer of type BUFTYPE */
+#define FFI_BUF_VALUE(BUF, BUFTYPE, CTYPE)			\
+    *((CTYPE*)((BUF) + SUBVAL_OFFSET(BUFTYPE, CTYPE)))
+
+/* Check whether the native value contained in BUF (of type BUFTYPE)
+ * fits in an Erlang small integer (with sign) */
+#define FFI_BUF_IS_SSMALL(BUF, BUFTYPE)					\
+    IS_SSMALL(FFI_BUF_VALUE(BUF, BUFTYPE, BUFTYPE))
+
+/* Check whether the native value contained in BUF (of type BUFTYPE)
+ * fits in an Erlang small integer (without sign) */
+#define FFI_BUF_IS_USMALL(BUF, BUFTYPE)					\
+    IS_USMALL(0, FFI_BUF_VALUE(BUF, BUFTYPE, BUFTYPE))
+
+/* Create an Erlang small integer from a buffer (of type BUFTYPE)
+ * containing a native sub-value (of type CTYPE) */
+#define FFI_NATIVE_TO_SMALL(SRC, BUFTYPE, CTYPE)		\
+    make_small(FFI_BUF_VALUE(SRC, BUFTYPE, CTYPE))
+
+/* Check whether the sub-value (of type CTYPE) stored in the given
+ * buffer (of type BUFTYPE) is negative */
+#define FFI_BUF_SIGN(BUF, BUFTYPE, CTYPE)		\
+    (FFI_BUF_VALUE(BUF, BUFTYPE, CTYPE) < ((CTYPE)0))
+
+/* Change the sign of the native value (of type OLDTYPE) stored in BUF
+ * (of type BUFTYPE).  The sign change will perform a cast from
+ * OLDTYPE to NEWTYPE.  NOTE: OLDTYPE and NEWTYPE should have the same
+ * sizeof()s, in order to avoid overflows */
+#define FFI_CHANGE_BUF_SIGN(BUF, BUFTYPE, OLDTYPE, NEWTYPE)		\
+    {									\
+	FFI_BUF_VALUE(BUF, BUFTYPE, NEWTYPE) =				\
+	    -(FFI_BUF_VALUE(BUF, BUFTYPE, OLDTYPE));			\
+    }
+
+/* Create an Erlang big integer from the given native-endianness
+ * buffer, using the given sign.  NOTE: the native buffer is assumed
+ * to contain an unsigned value; also, the native value must actually
+ * require a big integer in order to be stored (the function caller is
+ * required to verify that this is the case) */
+static inline Eterm _unsigned_native_to_big(Process *p, byte *src,
+					    unsigned int size, int sign)
+{
+    Uint *ptr;
+    unsigned int words_count;
+    Eterm *hp;
+#if WORDS_BIGENDIAN
+    byte le_buf[size];
+#endif
+
+    ASSERT(size >= sizeof(Uint));
+    ASSERT(!(size & ((unsigned int)1)));
+
+    if (size == sizeof(Uint)) {
+	/* The caller is expected to check that a big integer is
+	 * actually needed, and a small integer is not enough */
+	ASSERT(!FFI_BUF_IS_USMALL(src, Uint));
+
+	/* A single-word big integer is enough */
+	hp = ArithAlloc(p, 1 + 1);
+#if WORDS_BIGENDIAN
+	_copy_swap_native_le(le_buf, src, size);
+	src = le_buf;
+#endif
+	return bytes_to_big(src, size, sign, hp);
+    }
+    
+    /* We need to count the number of words actually needed to
+     * store the native number */
+    words_count = (size / sizeof(Uint)) + ((size % sizeof(Uint))
+					   ? 1 : 0);
+#if WORDS_BIGENDIAN
+    for (ptr = (Uint*)src;
+	 !(*ptr & ERL_FFI_WORD_MASK);
+	 ++ptr, --words_count);
+#else
+    for (ptr = ((Uint*)src) + (words_count - 1);
+	 !(*ptr & ERL_FFI_WORD_MASK);
+	 --ptr, --words_count);
+#endif
+
+    hp = ArithAlloc(p, 1 + words_count);
+#if WORDS_BIGENDIAN
+    _copy_swap_native_le(le_buf, src + (size - (words_count * sizeof(Uint))),
+			 words_count * sizeof(Uint));
+    src = le_buf;
+#endif
+    return bytes_to_big(src, words_count * sizeof(Uint), sign, hp);
+}
+
+/* Create an Erlang big integer (with sign) from a buffer containing
+ * an unsigned native integer (of type BUFTYPE) */
+#define FFI_UNSIGNED_NATIVE_TO_BIG(PROCESS, SRC, BUFTYPE, SIGN)		\
+    _unsigned_native_to_big((PROCESS), ((byte*)(SRC)), sizeof(BUFTYPE), (SIGN))
+
+#endif /* HAVE_LIBFFI */
+
+#endif /* __ERL_BIF_FFI_ENDIANNESS_H__ */
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/erl_init.c
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -39,6 +39,10 @@
 #include "erl_instrument.h"
 #include "erl_printf_term.h"
 #include "erl_misc_utils.h"
+
+#ifdef HAVE_LIBFFI
+#include "erl_bif_ffi.h"
+#endif
 
 #ifdef HIPE
 #include "hipe_mode_switch.h"	/* for hipe_mode_switch_init() */
@@ -252,6 +256,9 @@ erl_init(void)
     erts_init_bif();
     erts_init_obsolete();
     erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2);
+#ifdef HAVE_LIBFFI
+    erts_init_ffi();
+#endif
 #if HAVE_ERTS_MSEG
     erts_mseg_late_init(); /* Must be after timer (init_time()) and thread
 			      initializations */
diff -r f1993a64f66c -r 25dc4ec2c60b erts/emulator/beam/global.h
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -18,6 +18,10 @@
 
 #ifndef __GLOBAL_H__
 #define __GLOBAL_H__
+
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif
 
 #include "sys.h"
 #include "erl_alloc.h"
@@ -185,7 +189,22 @@ struct port {
 #define ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY -6
 #define ERL_DE_ERROR_UNSPECIFIED -7
 #define ERL_DE_LOOKUP_ERROR_NOT_FOUND -8
-#define ERL_DE_DYNAMIC_ERROR_OFFSET -10
+#define ERL_DE_FFI_PRELOADING_ERROR -9
+#define ERL_DE_ERROR_NO_FFI_FUNCTIONALITY -10
+#define ERL_DE_DYNAMIC_ERROR_OFFSET -12
+
+#ifdef HAVE_LIBFFI
+#include <ffi.h>
+
+typedef struct {
+    char *name;        /* Function name */
+    void *function;    /* Function pointer */
+    ffi_cif cif;       /* FFI Call InterFace (CIF) */
+    Uint nargs;        /* Number of FFI call arguments */
+    ffi_type** ftypes; /* Pointer to the array of ffi_type*'s */
+    Eterm *signature;  /* Function signature (array of FFI type atoms) */
+} FFIPreload;
+#endif /* HAVE_LIBFFI */
 
 typedef struct de_proc_entry {
     Process *proc;                   /* The process... */
@@ -213,6 +232,15 @@ typedef struct {
 				         full name of driver (path) */
     char         *reload_driver_name; /* ... and this contains the driver name */
     Uint         reload_flags;        /* flags for reloaded driver */
+    int          need_driver_init;    /* Does the associated
+				       * ErlDrvEntry need the driver
+				       * initialization structure? */
+    int          need_drventry_free;  /* Does the associated
+				       * ErlDrvEntry need to be freed? */
+#ifdef HAVE_LIBFFI
+    Uint         npreloads;           /* Number of preloaded FFI symbols */
+    FFIPreload   *preloads;           /* Array of preloaded FFI stuff */
+#endif /* HAVE_LIBFFI */
 } DE_Handle;
 
 /*
@@ -863,6 +891,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;
@@ -894,6 +929,10 @@ ERTS_GLB_INLINE int erts_smp_port_tryloc
 ERTS_GLB_INLINE int erts_smp_port_trylock(Port *prt);
 ERTS_GLB_INLINE void erts_smp_port_lock(Port *prt);
 ERTS_GLB_INLINE void erts_smp_port_unlock(Port *prt);
+
+/* Functions for two-phase unlock/deref, used by FFI */
+ERTS_GLB_INLINE void erts_smp_port_unlock_noderef(Port *prt);
+ERTS_GLB_INLINE void erts_smp_port_deref(Port *prt);
 
 #if ERTS_GLB_INLINE_INCL_FUNC_DEF
 
@@ -943,6 +982,36 @@ erts_smp_port_unlock(Port *prt)
 {
 #ifdef ERTS_SMP
     long refc;
+    refc = erts_smp_atomic_dectest(&prt->refc);
+    ASSERT(refc >= 0);
+    if (refc == 0)
+	erts_port_cleanup(prt);
+    else
+	erts_smp_mtx_unlock(prt->lock);
+#endif
+}
+
+/* Unlock a port without decrementing its refcount.  When this
+ * function is used, it MUST be followed by a erts_smp_port_deref() call */
+ERTS_GLB_INLINE void
+erts_smp_port_unlock_noderef(Port *prt)
+{
+#ifdef ERTS_SMP
+    ASSERT(erts_smp_atomic_read(&prt->refc) > 0);
+    erts_smp_mtx_unlock(prt->lock);
+#endif
+}
+
+/* Decrement the reference counting of a port.  This function MUST be
+ * called if and only if erts_smp_port_unlock_noderef() is used */
+ERTS_GLB_INLINE void
+erts_smp_port_deref(Port *prt)
+{
+#ifdef ERTS_SMP
+    long refc;
+
+    erts_smp_mtx_lock(prt->lock);
+
     refc = erts_smp_atomic_dectest(&prt->refc);
     ASSERT(refc >= 0);
     if (refc == 0)
diff -r f1993a64f66c -r 25dc4ec2c60b 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);
@@ -3265,21 +3299,21 @@ driver_binary_get_refc(ErlDrvBinary *dbp
 driver_binary_get_refc(ErlDrvBinary *dbp)
 {
     Binary* bp = ErlDrvBinary2Binary(dbp);
-    return erts_refc_read(&bp->refc, 1);
+    return erts_refc_read(&bp->refc, 0);
 }
 
 long
 driver_binary_inc_refc(ErlDrvBinary *dbp)
 {
     Binary* bp = ErlDrvBinary2Binary(dbp);
-    return erts_refc_inctest(&bp->refc, 2);
+    return erts_refc_inctest(&bp->refc, 1);
 }
 
 long
 driver_binary_dec_refc(ErlDrvBinary *dbp)
 {
     Binary* bp = ErlDrvBinary2Binary(dbp);
-    return erts_refc_dectest(&bp->refc, 1);
+    return erts_refc_dectest(&bp->refc, 0);
 }
 
 
diff -r f1993a64f66c -r 25dc4ec2c60b lib/Makefile
--- a/lib/Makefile
+++ b/lib/Makefile
@@ -59,7 +59,7 @@ else
           $(SSL_APP) toolbar tv observer debugger odbc runtime_tools \
           cosTransactions cosEvent cosTime cosNotification cosProperty \
           cosFileTransfer cosEventDomain et megaco webtool syntax_tools \
-	  xmerl edoc ssh inviso typer docbuilder
+	  xmerl edoc ssh inviso typer docbuilder ffi
 # dialyzer
         OTHER_SUB_DIRECTORIES += hipe
       else # BUILD_ALL on unix
@@ -69,7 +69,7 @@ else
           pman $(SSL_APP) toolbar tv observer odbc \
           runtime_tools cosTransactions cosEvent cosTime cosNotification \
           cosProperty cosFileTransfer cosEventDomain et megaco webtool \
-	  syntax_tools xmerl edoc ssh inviso typer docbuilder
+	  syntax_tools xmerl edoc ssh inviso typer docbuilder ffi
 # dialyzer
         OTHER_SUB_DIRECTORIES += hipe $(TSP_APP)
       endif
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/AUTHORS
--- /dev/null
+++ b/lib/ffi/AUTHORS
@@ -0,0 +1,5 @@
+Original Authors:
+
+  Alceste Scalas <alceste@crs4.it>
+
+Contributors:
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/Makefile
--- /dev/null
+++ b/lib/ffi/Makefile
@@ -0,0 +1,38 @@
+# ``The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved via the world wide web at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# The Initial Developer of the Original Code is  CRS4 - Center for
+# Advanced Studies, Research and Development in Sardinia
+# (http://www.crs4.it/). All Rights Reserved.''
+#
+# Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+# Author: Alceste Scalas <alceste@crs4.it>
+#
+#     $Id$
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+
+SUB_DIRECTORIES = src
+
+include vsn.mk
+VSN = $(FFI_VSN)
+
+SPECIAL_TARGETS = 
+
+# ----------------------------------------------------
+# Default Subdir Targets
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_subdir.mk
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/ebin/dummy_file_needed_by_hg
--- /dev/null
+++ b/lib/ffi/ebin/dummy_file_needed_by_hg
@@ -0,0 +1,2 @@
+This file is here just to make Mercurial, diff and patch consider this
+empty directory.
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/include/ffi_hardcodes.hrl.in
--- /dev/null
+++ b/lib/ffi/include/ffi_hardcodes.hrl.in
@@ -0,0 +1,169 @@
+%% @configure_input@
+
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is CRS4 - Center for
+%% Advanced Studies, Research and Development in Sardinia
+%% (http://www.crs4.it/). All Rights Reserved.''
+%% 
+%%     $Id$
+
+%% Foreign Function Interface (FFI) for Erlang/OTP
+%% Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+%% Author: Alceste Scalas <alceste@crs4.it>
+
+-ifndef(__FFI_HARDCODES_HRL__).
+-define(__FFI_HARDCODES_HRL__, 1).
+
+%%
+%% Hardcoded type sizes for FFI types.  If you decide to use them, you
+%% may need to recompile your BEAM files in order to make them run on
+%% different platforms.
+%%
+-define(FFI_HARDCODED_SIZEOF_UCHAR, 1).
+-define(FFI_HARDCODED_UCHAR_BITS, 8).
+-define(FFI_HARDCODED_SIZEOF_SCHAR, 1).
+-define(FFI_HARDCODED_SCHAR_BITS, 8).
+
+-define(FFI_HARDCODED_SIZEOF_USHORT, @SIZEOF_UNSIGNED_SHORT@).
+-define(FFI_HARDCODED_USHORT_BITS, @UNSIGNED_SHORT_BITS@).
+-define(FFI_HARDCODED_SIZEOF_SSHORT, @SIZEOF_SHORT@).
+-define(FFI_HARDCODED_SSHORT_BITS, @SHORT_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_UINT, @SIZEOF_UNSIGNED_INT@).
+-define(FFI_HARDCODED_UINT_BITS, @UNSIGNED_INT_BITS@).
+-define(FFI_HARDCODED_SIZEOF_SINT, @SIZEOF_INT@).
+-define(FFI_HARDCODED_SINT_BITS, @INT_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_ULONG, @SIZEOF_UNSIGNED_LONG@).
+-define(FFI_HARDCODED_ULONG_BITS, @UNSIGNED_LONG_BITS@).
+-define(FFI_HARDCODED_SIZEOF_SLONG, @SIZEOF_LONG@).
+-define(FFI_HARDCODED_SLONG_BITS, @LONG_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_UINT8, 1).
+-define(FFI_HARDCODED_UINT8_BITS, 8).
+-define(FFI_HARDCODED_SIZEOF_SINT8, 1).
+-define(FFI_HARDCODED_SINT8_BITS, 8).
+
+-define(FFI_HARDCODED_SIZEOF_UINT16, 2).
+-define(FFI_HARDCODED_UINT16_BITS, 16).
+-define(FFI_HARDCODED_SIZEOF_SINT16, 2).
+-define(FFI_HARDCODED_SINT16_BITS, 16).
+
+-define(FFI_HARDCODED_SIZEOF_UINT32, 4).
+-define(FFI_HARDCODED_UINT32_BITS, 32).
+-define(FFI_HARDCODED_SIZEOF_SINT32, 4).
+-define(FFI_HARDCODED_SINT32_BITS, 32).
+
+-define(FFI_HARDCODED_SIZEOF_UINT64, 8).
+-define(FFI_HARDCODED_UINT64_BITS, 64).
+-define(FFI_HARDCODED_SIZEOF_SINT64, 8).
+-define(FFI_HARDCODED_SINT64_BITS, 64).
+
+-define(FFI_HARDCODED_SIZEOF_FLOAT, @SIZEOF_FLOAT@).
+-define(FFI_HARDCODED_FLOAT_BITS, @FLOAT_BITS@).
+-define(FFI_HARDCODED_SIZEOF_DOUBLE, @SIZEOF_DOUBLE@).
+-define(FFI_HARDCODED_DOUBLE_BITS, @DOUBLE_BITS@).
+-define(FFI_HARDCODED_SIZEOF_LONG_DOUBLE, @SIZEOF_LONG_DOUBLE@).
+-define(FFI_HARDCODED_LONG_DOUBLE_BITS, @LONG_DOUBLE_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_POINTER, @SIZEOF_VOID_P@).
+-define(FFI_HARDCODED_POINTER_BITS, @VOID_P_BITS@).
+-define(FFI_HARDCODED_SIZEOF_CSTRING, @SIZEOF_VOID_P@).
+-define(FFI_HARDCODED_CSTRING_BITS, @VOID_P_BITS@).
+-define(FFI_HARDCODED_SIZEOF_NONNULL, @SIZEOF_VOID_P@).
+-define(FFI_HARDCODED_NONNULL_BITS, @VOID_P_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_SIZE_T, @SIZEOF_SIZE_T@).
+-define(FFI_HARDCODED_SIZE_T_BITS, @SIZE_T_BITS@).
+-define(FFI_HARDCODED_SIZEOF_SSIZE_T, @SIZEOF_SSIZE_T@).
+-define(FFI_HARDCODED_SSIZE_T_BITS, @SSIZE_T_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_OFF_T, @SIZEOF_OFF_T@).
+-define(FFI_HARDCODED_OFF_T_BITS, @OFF_T_BITS@).
+
+-define(FFI_HARDCODED_SIZEOF_PID_T, @SIZEOF_PID_T@).
+-define(FFI_HARDCODED_PID_T_BITS, @PID_T_BITS@).
+
+%%
+%% Hardcoded bit syntax macros for FFI types.  If you decide to use
+%% them, you may need to recompile your BEAM files in order to make
+%% them run on different platforms.
+%%
+-define(FFI_HARDCODED_UCHAR,
+        ?FFI_HARDCODED_UCHAR_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SCHAR,
+        ?FFI_HARDCODED_SCHAR_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_USHORT,
+        ?FFI_HARDCODED_USHORT_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SSHORT,
+        ?FFI_HARDCODED_SSHORT_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_UINT,
+        ?FFI_HARDCODED_UINT_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SINT,
+        ?FFI_HARDCODED_SINT_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_ULONG,
+        ?FFI_HARDCODED_ULONG_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SLONG,
+        ?FFI_HARDCODED_SLONG_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_UINT8,
+        ?FFI_HARDCODED_UINT8_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SINT8,
+        ?FFI_HARDCODED_SINT8_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_UINT16,
+        ?FFI_HARDCODED_UINT16_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SINT16,
+        ?FFI_HARDCODED_SINT16_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_UINT32,
+        ?FFI_HARDCODED_UINT32_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SINT32,
+        ?FFI_HARDCODED_SINT32_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_UINT64,
+        ?FFI_HARDCODED_UINT64_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SINT64,
+        ?FFI_HARDCODED_SINT64_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_FLOAT,
+        ?FFI_HARDCODED_FLOAT_BITS/native-float).
+-define(FFI_HARDCODED_DOUBLE,
+        ?FFI_HARDCODED_DOUBLE_BITS/native-float).
+
+%% Sorry, no long double support
+%%-define(FFI_HARDCODED_LONG_DOUBLE,     
+%%        ?FFI_HARDCODED_LONG_DOUBLE_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_POINTER,
+        ?FFI_HARDCODED_POINTER_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_CSTRING,
+        ?FFI_HARDCODED_CSTRING_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_NONNULL,
+        ?FFI_HARDCODED_NONNULL_BITS/native-unsigned-integer).
+
+-define(FFI_HARDCODED_SIZE_T,
+        ?FFI_HARDCODED_SIZE_T_BITS/native-unsigned-integer).
+-define(FFI_HARDCODED_SSIZE_T,
+        ?FFI_HARDCODED_SSIZE_T_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_OFF_T,
+        ?FFI_HARDCODED_OFF_T_BITS/native-signed-integer).
+
+-define(FFI_HARDCODED_PID_T,
+        ?FFI_HARDCODED_PID_T_BITS/native-signed-integer).
+
+-endif. % __FFI_HARDCODES_HRL__
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/info
--- /dev/null
+++ b/lib/ffi/info
@@ -0,0 +1,2 @@
+group: basic
+short: Foreign Function Interface (FFI)
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/src/Makefile
--- /dev/null
+++ b/lib/ffi/src/Makefile
@@ -0,0 +1,158 @@
+# ``The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved via the world wide web at http://www.erlang.org/.
+# 
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+# 
+# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+# AB. All Rights Reserved.''
+# 
+#     $Id$
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../vsn.mk
+VSN=$(FFI_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/ffi-$(VSN)
+
+# ----------------------------------------------------
+# Documentation directory specification
+# ----------------------------------------------------
+
+DOCDIR = ../doc
+
+
+### FFI uses EDOC for documentation, to regenerate update paths as needed!
+FFI_APP = ..
+
+EDOC_APP = ../../edoc
+
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+EDOC_MODULES = ffi
+
+MODULES = $(EDOC_MODULES)
+
+HRL_FILES = ../include/$(TARGET)/ffi_hardcodes.hrl
+INCLUDE_DIR = ../include
+
+INTERNAL_HRL_FILES  = 
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+APP_FILE= ffi.app
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+
+APPUP_FILE= ffi.appup
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+DOC_TARGET_FILES = $(EDOC_MODULES:%=$(DOCDIR)/%.html)
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += \
+		-I ../include \
+		+warn_unused_vars \
+		-I../include/$(TARGET) \
+		-DERL_BUILD_TARGET="\"$(TARGET)\""
+
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+debug opt: $(TARGET_FILES) 
+
+docs:
+#docs:	$(DOC_TARGET_FILES)
+
+
+clean:
+	$(RM) $(TARGET_FILES)
+	$(RM) core *~
+
+info:
+	@echo "MODULES: $(MODULES)"
+	@echo "EBIN: $(EBIN)"
+	@echo "EMULATOR: $(EMULATOR)"
+	@echo "APP_TARGET: $(APP_TARGET)"
+	@echo "TARGET_FILES: $(TARGET_FILES)"
+	@echo "DOC_TARGET_FILES: $(DOC_TARGET_FILES)"
+	@echo "DOCDIR/%html: $(DOCDIR)/%.html"
+
+realclean: clean
+	$(RM) $(DOC_TARGET_FILES)
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+EDOC_PATHS = \
+	-pa $(EDOC_APP)/ebin -pa $(FFI_APP)/ebin
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+	sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+	sed -e 's;%VSN%;$(VSN);' $< > $@
+
+$(EBIN)/%.beam:	%.erl
+	$(ERLC)  $(ERL_COMPILE_FLAGS) -o $(EBIN) $<
+
+$(DOCDIR)/%.html:	%.erl
+	$(ERL) -noshell $(EDOC_PATHS) \
+		-run edoc_run file '"$<"' '[{dir,"$(DOCDIR)"}]' -s erlang halt
+
+
+#$(DOCDIR)/%.html:	%.erl
+#	$(ERL) $(EDOC_PATHS) -s edoc file $< ['{dir,"$(DOCDIR)"}'] 
+
+# ----------------------------------------------------
+# Release Target
+# ---------------------------------------------------- 
+#ifeq "${MA_TOP}" ""
+#MA_TOP = ../../..
+#endif
+#include $(MA_TOP)/config/make.release
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_src:
+	$(INSTALL_DATA) $(MODULES:%=%.erl) $(RELSYSDIR)/src
+	$(INSTALL_DATA) Makefile $(RELSYSDIR)/src
+	$(INSTALL_DATA) $(APP_SRC) $(APPUP_SRC) $(RELSYSDIR)/src
+
+
+release_spec: opt
+	$(INSTALL_DIR) $(RELSYSDIR)/ebin
+	$(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+	$(INSTALL_DIR) $(RELSYSDIR)/src
+	$(INSTALL_DATA) $(ERL_FILES) $(APP_SRC) $(APPUP_SRC) $(RELSYSDIR)/src
+	$(INSTALL_DIR) $(RELSYSDIR)/include
+	$(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include
+
+release_docs_spec:
+
+
+
+#------------------------------------------------------------
+# .hrl dependencies
+$(EBIN)/ffi.beam:../include/$(TARGET)/ffi_hardcodes.hrl
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/src/ffi.app.src
--- /dev/null
+++ b/lib/ffi/src/ffi.app.src
@@ -0,0 +1,8 @@
+{application, ffi,
+ [{description, "Foreign Function Interface"},
+  {vsn, "%VSN%"},
+  {modules, [ffi]},
+  {registered, []},
+  {env, []},
+  {applications, [kernel, stdlib]}
+  ]}.
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/src/ffi.appup.src
--- /dev/null
+++ b/lib/ffi/src/ffi.appup.src
@@ -0,0 +1,14 @@
+{"%VSN%",
+ [
+  {"0.0.0.0",
+    [
+     ]
+  }
+ ],
+ [
+  {"0.0.0.0",
+    [
+     ]
+  }
+ ]
+}.
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/src/ffi.erl
--- /dev/null
+++ b/lib/ffi/src/ffi.erl
@@ -0,0 +1,436 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% The Initial Developer of the Original Code is  CRS4 - Center for
+%% Advanced Studies, Research and Development in Sardinia
+%% (http://www.crs4.it/). All Rights Reserved.''
+%%
+%% Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+%% Author: Alceste Scalas <alceste@crs4.it>
+%%
+%%     $Id$
+
+%% @doc Methods for calling native C functions from Erlang code, and
+%% handling their return values.
+%%
+%% @type type_tag() = atom().  Valid FFI type atom.
+%%
+%% @type tagged_value() = tuple(type_tag(), term()).  Type-tagged value
+%%                                                    used for FFI calls.
+%%
+%% @type c_func_name() = atom() | string().  Name of a C function.
+%%
+%% @type func_index() = integer().  Function position on the list of preloads
+%%                                  given to erl_ddll:load_library/3.
+%%
+%% @type tagged_func_name() = tuple(type_tag(), c_func_name()).  C function
+%%                                                               name with
+%%                                                               return type.
+%%
+%% @type tagged_func_index() = tuple(type_tag(), func_index()).  C function
+%%                                                               index with
+%%                                                               return type.
+-module(ffi).
+-author("Alceste Scalas <alceste@crs4.it>").
+-export([call/3,
+	 buffer_to_binary/2, cstring_to_binary/1,
+	 sizeof/1, min/1, max/1,
+	 check/1]).
+
+-ifdef(ERL_BUILD_TARGET).
+%% We are being built, so the current include path allows this -include().
+-include("ffi_hardcodes.hrl").
+-else.
+-include_lib("ffi/include/ffi_hardcodes.hrl").
+-endif.
+
+%% @spec call(Port::port(), CFunc::cfunction(),
+%%            Args::[tagged_value()]) -> Ret::tagged_value()
+%%       cfunction() = func_name() | func_index()
+%%                     | tagged_func_name() | tagged_func_index()
+%%
+%% @doc Call the C function <code>CFunc</code> with the given list of
+%% arguments, using the port <code>Port</code>.  If the function was
+%% preloaded with ffi:load_library/3, all the type tags will be
+%% matched against the preloaded signature before performing the call.
+%%
+%% Return the return value of the C function, with the proper type tag.
+%%
+%% <strong>Note:</strong> if <code>CFunc</code> is not of type {@link
+%% tagged_func_name()}, the C function will be called if and only if
+%% it was preloaded with erl_ddll:load_library/3 (it is required in
+%% order to determine its return type).
+call(Port, {RetTypeTag, CFunc}, Args) when is_integer(CFunc) ->
+    %% Called with type tag + function index
+    {name, Lib} = .erlang:port_info(Port, name),
+    Preloads = [P || P <- .erl_ddll:info(Lib, preloads),
+		    .proplists:get_value(index, P) =:= CFunc],
+    case Preloads of
+	[P] ->
+	    do_preloaded_call(Port, RetTypeTag, P, Args);
+	[] ->
+	    %% Function index was out of range
+	    .erlang:error(badarg);
+	_ ->
+	    %% This should never happen (Preloads contains more than
+	    %% one element with the same index?!?)
+	    .erlang:error({bug, {duplicated_preloads, Preloads}})
+    end;
+call(Port, {RetTypeTag, CFunc}, Args) when is_list(CFunc) ->
+    %% Called with type tag + function name as string
+    {name, Lib} = .erlang:port_info(Port, name),
+    Preloads = [P || P <- .erl_ddll:info(Lib, preloads),
+		     .proplists:get_value(name, P) =:= CFunc],
+    case Preloads of
+	[] ->
+	    %% The function was not preloaded, but we have enough
+	    %% information to do a function call
+	    do_call(Port, RetTypeTag, CFunc, Args);
+	_ ->
+	    %% We support multiple matches on function names, because
+	    %% they could be used to preload different calls to C
+	    %% vararg functions (at least on some platforms).
+	    try_preloaded_calls(Port, RetTypeTag, Preloads, Args)
+    end;
+call(Port, {RetTypeTag, CFunc}, Args) when is_atom(CFunc) ->
+    %% Called with type tag + function name as atom
+    call(Port, {RetTypeTag, atom_to_list(CFunc)}, Args);
+call(Port, CFunc, Args) when is_integer(CFunc) ->
+    %% Called with function index alone
+    {name, Lib} = .erlang:port_info(Port, name),
+    Preloads = [P || P <- .erl_ddll:info(Lib, preloads),
+		     .proplists:get_value(index, P) =:= CFunc],
+    case Preloads of
+	[P] ->
+	    RetTypeTag = element(1, .proplists:get_value(signature, P)),
+	    do_preloaded_call(Port, RetTypeTag, P, Args);
+	[] ->
+	    %% Function index was out of range
+	    .erlang:error(badarg);
+	_ ->
+	    %% This should never happen (Preloads contains more than
+	    %% one element with the same index?!?)
+	    .erlang:error({bug, {duplicated_preloads, Preloads}})
+    end;
+call(Port, CFunc, Args) when is_list(CFunc) ->
+    %% Called with function name alone as string
+    {name, Lib} = .erlang:port_info(Port, name),
+    Preloads = [P || P <- .erl_ddll:info(Lib, preloads),
+		     .proplists:get_value(name, P) =:= CFunc],
+    case Preloads of
+	[] ->
+	    %% The function was not preloaded, so we miss the
+	    %% type_tag() for building the return value: let's fail
+	    .erlang:error(badarg);
+	_ ->
+	    %% We support multiple matches on function names, because they
+	    %% could be used to preload different calls to C vararg functions
+	    %% (at least on some platforms).
+	    try_preloaded_calls(Port, Preloads, Args)
+    end;
+call(Port, CFunc, Args) when is_atom(CFunc) ->
+    %% Called with function name alone as atom
+    call(Port, atom_to_list(CFunc), Args).
+
+%% Try to perform FFI calls from a list of preloaded function, until
+%% one matches the given arguments and return types
+try_preloaded_calls(Port, RetTypeTag, [Preload], Args) ->
+    %% Laast element on the preloads list: call it and see what
+    %% happens
+    do_preloaded_call(Port, RetTypeTag, Preload, Args);
+try_preloaded_calls(Port, RetTypeTag, [Preload | Rest], Args) ->
+    try
+	do_preloaded_call(Port, RetTypeTag, Preload, Args)
+    catch
+	error:{badmatch, _} ->
+	    %% The preload signature was wrong, let's try with the
+	    %% next one
+	    try_preloaded_calls(Port, Rest, Args)
+    end.
+
+%% Try to perform FFI calls from a list of preloaded function, until
+%% one matches the given arguments types (the return type is taken
+%% from the preload itself)
+try_preloaded_calls(Port, [Preload], Args) ->
+    %% Laast element on the preloads list: call it and see what
+    %% happens
+    RetTypeTag = element(1, .proplists:get_value(signature, Preload)),
+    do_preloaded_call(Port, RetTypeTag, Preload, Args);
+try_preloaded_calls(Port, [Preload | Rest], Args) ->
+    RetTypeTag = element(1, .proplists:get_value(signature, Preload)),
+    try
+	do_preloaded_call(Port, RetTypeTag, Preload, Args)
+    catch
+	error:{badmatch, _} ->
+	    %% The preload signature was wrong, let's try with the
+	    %% next one
+	    try_preloaded_calls(Port, Rest, Args)
+    end.
+
+%% Perform a FFI call using the given preload information.  Match the
+%% preloaded function signature with RetTypeTag and arguments type tags.
+do_preloaded_call(Port, RetTypeTag, Preload, Args) ->
+    check_arguments(Args),
+    
+    %% Build and match function signature
+    Sig = list_to_tuple([RetTypeTag] ++ [element(1, Arg) || Arg <- Args]),
+    Sig = .proplists:get_value(signature, Preload),
+    
+    %% If we are here, the signatures did match
+    RawArgs = [element(2, Arg) || Arg <- Args],
+
+    RetVal = .ffi:raw_call(Port,
+			   list_to_tuple([.proplists:get_value(index,
+							       Preload)]
+					 ++ RawArgs)),
+    {RetTypeTag, RetVal}.
+
+%% Perform a FFI call (without preload info).
+do_call(Port, RetTypeTag, CFunc, Args) ->
+    check_arguments(Args),
+    
+    %% Build and match function signature
+    Sig = list_to_tuple([RetTypeTag] ++ [element(1, Arg) || Arg <- Args]),
+    RawArgs = [element(2, Arg) || Arg <- Args],
+
+    RetVal = .ffi:raw_call(Port, list_to_tuple([CFunc] ++ RawArgs), Sig),
+    {RetTypeTag, RetVal}.
+
+%% Raise an exception if any element in the arguments list is not a
+%% valid type-tagged value
+check_arguments(Args) ->
+    Check = .lists:all(fun check/1, Args),
+    if
+	Check ->
+	    ok;
+	true ->
+	    .erlang:error(badarg)
+    end.
+
+%% @spec buffer_to_binary(TaggedNonnull:nonnull(), Size) -> binary()
+%%       nonnull() = tuple(nonnull, integer())
+%%
+%% @doc Create a binary with a copy of <code>Size</code> bytes taken
+%% from the given C buffer (a type-tagged C non-null pointer).
+%%
+%% Return the new binary.
+buffer_to_binary({nonnull, Ptr}, Size) ->
+    IsValid = check({nonnull, Ptr}),
+    if
+	IsValid ->
+	    .ffi:raw_buffer_to_binary(Ptr, Size);
+	true ->
+	    .erlang:error(badarg)
+    end.
+
+%% @spec cstring_to_binary(TaggedCString::cstring()) -> binary()
+%%       cstring() = tuple(cstring, integer())
+%%
+%% @doc Create a binary with a copy of the given C string (a
+%% type-tagged C non-null pointer).  The binary will include the trailing '\0'
+%% character.
+%%
+%% Return the new binary.
+cstring_to_binary({cstring, Ptr}) ->
+    IsValid = check({cstring, Ptr}),
+    if
+	IsValid ->
+	    .ffi:raw_cstring_to_binary(Ptr);
+	true ->
+	    .erlang:error(badarg)
+    end.
+
+%% @spec sizeof(TypeTag::type_tag()) -> integer()
+%%
+%% @doc Return the size of the given FFI type tag, on the current system.
+sizeof(uchar) ->
+    ?FFI_HARDCODED_SIZEOF_UCHAR;
+sizeof(schar) ->
+    ?FFI_HARDCODED_SIZEOF_SCHAR;
+sizeof(ushort) ->
+    ?FFI_HARDCODED_SIZEOF_USHORT;
+sizeof(sshort) ->
+    ?FFI_HARDCODED_SIZEOF_SSHORT;
+sizeof(uint) ->
+    ?FFI_HARDCODED_SIZEOF_UINT;
+sizeof(sint) ->
+    ?FFI_HARDCODED_SIZEOF_SINT;
+sizeof(ulong) ->
+    ?FFI_HARDCODED_SIZEOF_ULONG;
+sizeof(slong) ->
+    ?FFI_HARDCODED_SIZEOF_SLONG;
+sizeof(uint8) ->
+    ?FFI_HARDCODED_SIZEOF_UINT8;
+sizeof(sint8) ->
+    ?FFI_HARDCODED_SIZEOF_SINT8;
+sizeof(uint16) ->
+    ?FFI_HARDCODED_SIZEOF_UINT16;
+sizeof(sint16) ->
+    ?FFI_HARDCODED_SIZEOF_SINT16;
+sizeof(uint32) ->
+    ?FFI_HARDCODED_SIZEOF_UINT32;
+sizeof(sint32) ->
+    ?FFI_HARDCODED_SIZEOF_SINT32;
+sizeof(uint64) ->
+    ?FFI_HARDCODED_SIZEOF_UINT64;
+sizeof(sint64) ->
+    ?FFI_HARDCODED_SIZEOF_SINT64;
+sizeof(float) ->
+    ?FFI_HARDCODED_SIZEOF_FLOAT;
+sizeof(double) ->
+    ?FFI_HARDCODED_SIZEOF_DOUBLE;
+sizeof(longdouble) ->
+    ?FFI_HARDCODED_SIZEOF_LONG_DOUBLE;
+sizeof(pointer) ->
+    ?FFI_HARDCODED_SIZEOF_POINTER;
+sizeof(cstring) ->
+    ?FFI_HARDCODED_SIZEOF_POINTER;
+sizeof(nonnull) ->
+    ?FFI_HARDCODED_SIZEOF_POINTER;
+sizeof(size_t) ->
+    ?FFI_HARDCODED_SIZEOF_SIZE_T;
+sizeof(ssize_t) ->
+    ?FFI_HARDCODED_SIZEOF_SSIZE_T;
+sizeof(off_t) ->
+    ?FFI_HARDCODED_SIZEOF_OFF_T;
+sizeof(pid_t) ->
+    ?FFI_HARDCODED_SIZEOF_PID_T.
+
+%% @spec min(TypeTag::type_tag()) -> integer()
+%%
+%% @doc Return the minimum <em>integer</em> value allowed by the given
+%% FFI type.
+%%
+%% <strong>Note:</strong> only integer-based tagged values are
+%% supported (including C pointers).  Floating point values, in
+%% particular, are not supported.
+min(uchar) ->
+    0;
+min(schar) ->
+    -(1 bsl (?FFI_HARDCODED_SCHAR_BITS - 1));
+min(ushort) ->
+    0;
+min(sshort) ->
+    -(1 bsl (?FFI_HARDCODED_SSHORT_BITS - 1));
+min(uint) ->
+    0;
+min(sint) ->
+    -(1 bsl (?FFI_HARDCODED_SINT_BITS - 1));
+min(ulong) ->
+    0;
+min(slong) ->
+    -(1 bsl (?FFI_HARDCODED_SLONG_BITS - 1));
+min(uint8) ->
+    0;
+min(sint8) ->
+    -(1 bsl (?FFI_HARDCODED_SINT8_BITS - 1));
+min(uint16) ->
+    0;
+min(sint16) ->
+    -(1 bsl (?FFI_HARDCODED_SINT16_BITS - 1));
+min(uint32) ->
+    0;
+min(sint32) ->
+    -(1 bsl (?FFI_HARDCODED_SINT32_BITS - 1));
+min(uint64) ->
+    0;
+min(sint64) ->
+    -(1 bsl (?FFI_HARDCODED_SINT64_BITS - 1));
+min(pointer) ->
+    0;
+min(cstring) ->
+    1; % Cannot be NULL
+min(nonnull) ->
+    1; % Cannot be NULL
+min(size_t) ->
+    0;
+min(ssize_t) ->
+    -(1 bsl (?FFI_HARDCODED_SSIZE_T_BITS - 1));
+min(off_t) ->
+    -(1 bsl (?FFI_HARDCODED_OFF_T_BITS - 1));
+min(pid_t) ->
+    -(1 bsl (?FFI_HARDCODED_PID_T_BITS - 1)).
+
+%% @spec max(TypeTag::type_tag()) -> integer()
+%%
+%% @doc Return the maximum value allowed by the given
+%% <em>integer-based</em> FFI type.
+%%
+%% <strong>Note:</strong> only integer-based tagged values are
+%% supported (including C pointers).  Floating point values, in
+%% particular, are not supported.
+max(uchar) ->
+    (1 bsl ?FFI_HARDCODED_UCHAR_BITS) - 1;
+max(schar) ->
+    (1 bsl (?FFI_HARDCODED_SCHAR_BITS - 1)) - 1;
+max(ushort) ->
+    (1 bsl ?FFI_HARDCODED_USHORT_BITS) - 1;
+max(sshort) ->
+    (1 bsl (?FFI_HARDCODED_SSHORT_BITS - 1)) - 1;
+max(uint) ->
+    (1 bsl ?FFI_HARDCODED_UINT_BITS) - 1;
+max(sint) ->
+    (1 bsl (?FFI_HARDCODED_SINT_BITS - 1)) - 1;
+max(ulong) ->
+    (1 bsl ?FFI_HARDCODED_ULONG_BITS) - 1;
+max(slong) ->
+    (1 bsl (?FFI_HARDCODED_SLONG_BITS - 1)) - 1;
+max(uint8) ->
+    (1 bsl ?FFI_HARDCODED_UINT8_BITS) - 1;
+max(sint8) ->
+    (1 bsl (?FFI_HARDCODED_SINT8_BITS - 1)) - 1;
+max(uint16) ->
+    (1 bsl ?FFI_HARDCODED_UINT16_BITS) - 1;
+max(sint16) ->
+    (1 bsl (?FFI_HARDCODED_SINT16_BITS - 1)) - 1;
+max(uint32) ->
+    (1 bsl ?FFI_HARDCODED_UINT32_BITS) - 1;
+max(sint32) ->
+    (1 bsl (?FFI_HARDCODED_SINT32_BITS - 1)) - 1;
+max(uint64) ->
+    (1 bsl ?FFI_HARDCODED_UINT64_BITS) - 1;
+max(sint64) ->
+    (1 bsl (?FFI_HARDCODED_SINT64_BITS - 1)) - 1;
+max(pointer) ->
+    (1 bsl ?FFI_HARDCODED_POINTER_BITS) - 1;
+max(cstring) ->
+    (1 bsl ?FFI_HARDCODED_CSTRING_BITS) - 1;
+max(nonnull) ->
+    (1 bsl ?FFI_HARDCODED_NONNULL_BITS) - 1;
+max(size_t) ->
+    (1 bsl ?FFI_HARDCODED_SIZE_T_BITS) - 1;
+max(ssize_t) ->
+    (1 bsl (?FFI_HARDCODED_SSIZE_T_BITS - 1)) - 1;
+max(off_t) ->
+    (1 bsl (?FFI_HARDCODED_OFF_T_BITS - 1)) - 1;
+max(pid_t) ->
+    (1 bsl (?FFI_HARDCODED_PID_T_BITS - 1)) - 1.
+
+%% @spec check(TaggedValue::tagged_value()) -> true | false
+%%
+%% @doc Check that the given type-tagged value is valid.
+%%
+%% This function performs range and type checking.
+%%
+%% <strong>Note:</strong> only integer-based tagged values are
+%% completely supported (including C pointers).  Checks on floating
+%% point values will always return <code>true</code> (unless the
+%% tagged value is malformed).
+check({void, void}) ->
+    true;
+check({TypeTag, Value}) when ((TypeTag == float) or (TypeTag == double)
+			      or (TypeTag == longdouble))
+			     and is_float(Value) ->
+    true;
+check({TypeTag, Value}) when is_atom(TypeTag) and is_integer(Value) ->
+    (Value =< max(TypeTag)) and (Value >= min(TypeTag));
+check(_) ->
+    false.
diff -r f1993a64f66c -r 25dc4ec2c60b lib/ffi/vsn.mk
--- /dev/null
+++ b/lib/ffi/vsn.mk
@@ -0,0 +1,1 @@
+FFI_VSN = 0.0.0.1
diff -r f1993a64f66c -r 25dc4ec2c60b lib/kernel/src/erl_ddll.erl
--- a/lib/kernel/src/erl_ddll.erl
+++ b/lib/kernel/src/erl_ddll.erl
@@ -22,7 +22,7 @@
 
 -module(erl_ddll).
 
--export([load_driver/2, load/2, 
+-export([load_driver/2, load/2, load_library/3, load_library/2,
 	 unload_driver/1, unload/1, reload/2, reload_driver/2, 
 	 format_error/1,info/1,info/0, start/0, stop/0]).
 
@@ -37,6 +37,12 @@ load_driver(Path, Driver) ->
 
 load(Path, Driver) ->
     do_load_driver(Path, Driver, []).
+
+load_library(Path, Library) ->
+    load_library(Path, Library, []).
+
+load_library(Path, Library, OptionList) ->
+    do_load_driver(Path, Library, OptionList ++ [{need_driver_init, false}]).
 
 do_load_driver(Path, Driver, DriverFlags) ->
     case erl_ddll:try_load(Path, Driver,[{monitor,pending_driver}]++DriverFlags) of
@@ -112,7 +118,8 @@ info(Driver) ->
      {linked_in_driver, erl_ddll:info(Driver,linked_in_driver)},
      {permanent, erl_ddll:info(Driver,permanent)},
      {awaiting_load,  erl_ddll:info(Driver,awaiting_load)},
-     {awaiting_unload, erl_ddll:info(Driver,awaiting_unload)}].
+     {awaiting_unload, erl_ddll:info(Driver,awaiting_unload)},
+     {preloads, erl_ddll:info(Driver,preloads)}].
 
 info() ->
     {ok,DriverList} = erl_ddll:loaded_drivers(),
diff -r f1993a64f66c -r 25dc4ec2c60b lib/kernel/src/erlang.erl
--- a/lib/kernel/src/erlang.erl
+++ b/lib/kernel/src/erlang.erl
@@ -20,7 +20,7 @@
 -export([apply/2,apply/3,spawn/4,spawn_link/4,
 	 spawn_monitor/1,spawn_monitor/3,
 	 spawn_opt/2,spawn_opt/3,spawn_opt/4,spawn_opt/5,
-	 disconnect_node/1]).
+	 disconnect_node/1, open_port/1]).
 -export([spawn/1, spawn_link/1, spawn/2, spawn_link/2]).
 -export([yield/0]).
 -export([crasher/6]).
@@ -528,3 +528,5 @@ get_demonitor_opts([flush|Opts], _Flush)
     get_demonitor_opts(Opts, true).
 
 
+open_port(Library) ->
+    open_port({spawn, Library}, [binary]).
