diff -r 27be1eed792a -r 7900110199cc lib/kernel/src/Makefile
--- a/lib/kernel/src/Makefile
+++ b/lib/kernel/src/Makefile
@@ -80,6 +80,7 @@ MODULES = \
 	erts_debug \
 	error_handler \
 	error_logger \
+	ffi \
 	file \
 	file_io_server \
 	file_server \
diff -r 27be1eed792a -r 7900110199cc lib/kernel/src/ffi.erl
--- /dev/null
+++ b/lib/kernel/src/ffi.erl
@@ -0,0 +1,212 @@
+%% ``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]).
+
+%% @spec call(Port::port(), CFunc,
+%%            Args::[tagged_value()]) -> Ret::tagged_value()
+%%       CFunc = 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) ->
+    %% 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) ->
+    %% 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}.
+
+%% @spec buffer_to_binary(TaggedNonnull, Size) -> binary()
+%%       TaggedNonnull = 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) ->
+    .ffi:raw_buffer_to_binary(Ptr, Size).
+
+%% @spec cstring_to_binary(TaggedCString) -> binary()
+%%       TaggedCString = 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}) ->
+    .ffi:raw_cstring_to_binary(Ptr).
