diff -r 17e18582d287 -r 27be1eed792a erts/emulator/beam/atom.names
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -93,6 +93,7 @@ atom DOWN='DOWN'
 atom DOWN='DOWN'
 atom UP='UP'
 atom EXIT='EXIT'
+atom address
 atom all
 atom allocated
 atom allocated_areas
@@ -361,6 +362,7 @@ atom port
 atom port
 atom port_count
 atom preload
+atom preloads
 atom print
 atom priority
 atom private
@@ -409,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 17e18582d287 -r 27be1eed792a erts/emulator/beam/erl_bif_ddll.c
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -46,6 +46,7 @@
 #include "dist.h"
 #include "erl_version.h"
 #include "erl_bif_ffi.h"
+#include "erl_bits.h"
 
 #ifdef ERTS_SMP
 #define DDLL_SMP 1
@@ -108,6 +109,7 @@ static int build_ffi_preloads(Eterm lst,
 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)
@@ -815,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;
@@ -1643,7 +1652,7 @@ static int do_load_driver_entry(DE_Handl
 	/* 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, strlen(name) + 1);
+	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;
@@ -2103,6 +2112,7 @@ static int build_ffi_preloads(Eterm lst,
     int status = 0;
     FFIPreload *preloads = NULL;
     Eterm l, tp, argstp, *tpval, *argstpval;
+    Eterm *signatures;
     char *funcname = NULL, *fnames;
     ffi_type **ftypes;
     void *fptr;
@@ -2148,9 +2158,11 @@ static int build_ffi_preloads(Eterm lst,
     preloads = erts_alloc(ERTS_ALC_T_DDLL_HANDLE,
 			  (npreloads * sizeof(FFIPreload))
 			  + (total_ftypes * sizeof(ffi_type*))
-			  + (total_strlen + npreloads /* For final \0's */));
+			  + (total_strlen + npreloads) /* For final \0's */
+			  + (total_ftypes * sizeof(Eterm))); /* Signature */
     ftypes = (ffi_type**)(preloads + npreloads);
-    fnames = (char*)(ftypes + total_ftypes);
+    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){
@@ -2172,6 +2184,10 @@ static int build_ffi_preloads(Eterm lst,
 
 	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)))
@@ -2219,4 +2235,83 @@ static void refresh_ffi_preloads(DE_Hand
 	preloads[i].function = driver_dl_sym(dh->handle, preloads[i].name);
     }
 }
+
+/* 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];
+
+    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 17e18582d287 -r 27be1eed792a erts/emulator/beam/global.h
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -202,6 +202,7 @@ typedef struct {
     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 */
 
diff -r 17e18582d287 -r 27be1eed792a lib/kernel/src/erl_ddll.erl
--- a/lib/kernel/src/erl_ddll.erl
+++ b/lib/kernel/src/erl_ddll.erl
@@ -118,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(),
