diff -r e57f605f4c99 -r ee8cb854ed24 erts/emulator/beam/bif.tab
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -690,5 +690,5 @@ bif erlang:old_binary_to_term/1
 #
 # FFI BIFs
 #
-bif ffi:call/3
-bif ffi:call/2
+bif ffi:raw_call/3
+bif ffi:raw_call/2
diff -r e57f605f4c99 -r ee8cb854ed24 erts/emulator/beam/erl_bif_ddll.c
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -13,8 +13,9 @@
  * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
  * AB. All Rights Reserved.''
  * 
- * FFI and generic library loading support added by:
- * Alceste Scalas <alceste@crs4.it>
+ * FFI and generic library loading support:
+ *     Copyright (C) 2007 by CRS4 - http://www.crs4.it/
+ *     Author: Alceste Scalas <alceste@crs4.it>
  *
  *     $Id$
  */
diff -r e57f605f4c99 -r ee8cb854ed24 erts/emulator/beam/erl_bif_ffi.c
--- a/erts/emulator/beam/erl_bif_ffi.c
+++ b/erts/emulator/beam/erl_bif_ffi.c
@@ -45,13 +45,13 @@
  * Since libffi is not supported, we always return an error when using
  * one of the FFI BIFs
  */
-BIF_RETTYPE ffi_call_3(BIF_ALIST_3)
+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_call_2(BIF_ALIST_2)
+BIF_RETTYPE ffi_raw_call_2(BIF_ALIST_2)
 {
     /* FIXME: a more descriptive error is definitely required */
     BIF_ERROR(BIF_P, BADARG);
@@ -121,7 +121,7 @@ Eterm erts_make_signed_integer(Sint x, P
  * function return type, while Arg1Type...  are the C types of the
  * function call arguments.
  */
-BIF_RETTYPE ffi_call_3(BIF_ALIST_3)
+BIF_RETTYPE ffi_raw_call_3(BIF_ALIST_3)
 {
     Port* p;
     void* handle;
@@ -223,7 +223,7 @@ BIF_RETTYPE ffi_call_3(BIF_ALIST_3)
  * 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)
+BIF_RETTYPE ffi_raw_call_2(BIF_ALIST_2)
 {
     Port* p;
     DE_Handle* de_handle;
@@ -590,7 +590,7 @@ static Eterm build_ffi_return_term(Proce
     Uint64 tmpu64;
 
     if (rtype == &ffi_type_void) {
-        return am_ok;
+        return am_void;
     } else if (rtype == &ffi_type_float) {
         f.fd = *((float*) retval);
         hp = HAlloc(p, FLOAT_SIZE_OBJECT);
diff -r e57f605f4c99 -r ee8cb854ed24 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, load_library/3,
+-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,9 @@ 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}]).
diff -r e57f605f4c99 -r ee8cb854ed24 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]).
