diff -r 9a79d846ae21 -r e57f605f4c99 erts/emulator/beam/bif.tab
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -691,3 +691,4 @@ bif erlang:old_binary_to_term/1
 # FFI BIFs
 #
 bif ffi:call/3
+bif ffi:call/2
diff -r 9a79d846ae21 -r e57f605f4c99 erts/emulator/beam/erl_bif_ffi.c
--- a/erts/emulator/beam/erl_bif_ffi.c
+++ b/erts/emulator/beam/erl_bif_ffi.c
@@ -46,6 +46,12 @@
  * one of the FFI BIFs
  */
 BIF_RETTYPE ffi_call_3(BIF_ALIST_3)
+{
+    /* FIXME: a more descriptive error is definitely required */
+    BIF_ERROR(BIF_P, BADARG);
+}
+
+BIF_RETTYPE ffi_call_2(BIF_ALIST_2)
 {
     /* FIXME: a more descriptive error is definitely required */
     BIF_ERROR(BIF_P, BADARG);
@@ -204,6 +210,104 @@ BIF_RETTYPE ffi_call_3(BIF_ALIST_3)
     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_call_2(BIF_ALIST_2)
+{
+    Port* p;
+    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 */
+
+    p = id_or_name2port(BIF_P, BIF_ARG_1);
+    if (!p) {
+    error:
+        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 (!p->drv_ptr)
+        goto error; /* The port is not associated to a driver */    
+    de_handle = (DE_Handle*) p->drv_ptr->handle;
+    npreloads = de_handle->npreloads;
+
+    /* Is the given function index within bounds? */
+    if ((func_idx > npreloads) || (func_idx == 0))
+	goto 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 error;
+
+    /* Is the function call arity compatible with the precompiled FFI
+     * signature? */
+    if (nargs != preload->nargs)
+	goto error;
+
+    {
+        Sint64 retval[2]; /* FFI call return value (must be large & aligned) */
+        void* avalues[nargs - 1]; /* Pointers to arguments data */
+        byte buf[ERL_FFI_ARGS_BUF_SIZE]; /* Buffer for FFI arguments */
+
+        /* Prepare the FFI function call... */
+        if ((status = build_ffi_args_array(calltp+1,
+					   preload->ftypes + 1, buf, avalues,
+					   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);
+    }
+
+    BIF_RET(res);
+
+    late_error:
+    if (status) {
+        switch (status) {
+        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);
+        }
     }
 }
 
