gnome-perl-introspection r11 - in Glib-Object-Introspection/trunk: . xs

[tsch svn gnome org]

Author: tsch
Date: Sat Mar 15 22:56:01 2008
New Revision: 11
URL: http://svn.gnome.org/viewvc/gnome-perl-introspection?rev=11&view=rev

Log:
	* IdlFunctionInfo.xs (XS_Glib__Idl__FunctionInfo_invoke): Use
	libffi directly instead of g_function_info_invoke for function
	invocation.


Added:
   Glib-Object-Introspection/trunk/ChangeLog
Modified:
   Glib-Object-Introspection/trunk/xs/IdlFunctionInfo.xs

Modified: Glib-Object-Introspection/trunk/xs/IdlFunctionInfo.xs
==============================================================================
--- Glib-Object-Introspection/trunk/xs/IdlFunctionInfo.xs	(original)
+++ Glib-Object-Introspection/trunk/xs/IdlFunctionInfo.xs	Sat Mar 15 22:56:01 2008
@@ -1095,6 +1095,15 @@
 
     {
 	GIFunctionInfo * info = SvGIFunctionInfo (ST(0));
+
+	ffi_cif cif;
+	ffi_type **arg_types = NULL;
+	ffi_type *return_type_ffi = NULL;
+	gpointer *args = NULL;
+	gpointer func_pointer = NULL;
+	GModule *module = NULL;
+	const gchar *symbol = NULL;
+
 	int have_args;
 	int n_args;
 	int n_in_args;
@@ -1102,17 +1111,22 @@
 	int i, out_i;
 	GITypeInfo ** out_arg_type = NULL;
 	GITypeInfo * return_type_info = NULL;
-	GITransfer return_type_transfer;
 	gboolean has_return_value;
 	GArgument return_value;
 	GArgument * in_args = NULL;
 	GArgument * out_args = NULL;
-	GError * error = NULL;
+
+	symbol = g_function_info_get_symbol (info);
 
 #ifdef NOISY
-	warn ("invoke: %s\n", g_function_info_get_symbol (info));
+	warn ("invoke: %s\n", symbol);
 #endif
 
+	module = g_module_open (NULL, 0);
+	if (!g_module_symbol (module, symbol, &func_pointer)) {
+		croak ("Could not locate symbol %s", symbol);
+	}
+
 #define OFFSET 1
 	have_args = items - OFFSET;
 	n_args = g_callable_info_get_n_args ((GICallableInfo *) info);
@@ -1125,12 +1139,17 @@
 		in_args = gperl_alloc_temp (sizeof (GArgument) * n_args);
 		out_args = gperl_alloc_temp (sizeof (GArgument) * n_args);
 		out_arg_type = gperl_alloc_temp (sizeof (GITypeInfo*) * n_args);
+
+		arg_types = gperl_alloc_temp (sizeof (ffi_type *) * n_args);
+		args = gperl_alloc_temp (sizeof (gpointer) * n_args);
 	}
 
 	n_in_args = n_out_args = 0;
 	for (i = 0 ; i < n_args ; i++) {
 		GIArgInfo * arg_info =
 			g_callable_info_get_arg ((GICallableInfo *) info, i);
+		/* In case of out and in-out args, arg_type is unref'ed after
+		 * the function has been invoked */
 		GITypeInfo * arg_type = g_arg_info_get_type (arg_info);
 		gboolean may_be_null = g_arg_info_may_be_null (arg_info);
 
@@ -1140,49 +1159,71 @@
 
 		switch (g_arg_info_get_direction (arg_info)) {
 		    case GI_DIRECTION_IN:
-			sv_to_arg (ST (i+OFFSET), in_args+n_in_args++, arg_type, may_be_null);
+			sv_to_arg (ST (i+OFFSET), &in_args[n_in_args], arg_type, may_be_null);
+			arg_types[i] = get_ffi_type (arg_type);
+			args[i] = &in_args[n_in_args];
 			g_base_info_unref ((GIBaseInfo *) arg_type);
+			n_in_args++;
 			break;
 		    case GI_DIRECTION_OUT:
-			out_args[n_out_args++].v_pointer =
+			out_args[n_out_args].v_pointer =
 				gperl_alloc_temp (sizeof (GArgument));
-			out_arg_type[n_out_args-1] = arg_type;
+			out_arg_type[n_out_args] = arg_type;
+			arg_types[i] = &ffi_type_pointer;
+			args[i] = &out_args[n_out_args];
+			n_out_args++;
 			break;
 		    case GI_DIRECTION_INOUT:
 		    {
 			GArgument * temp =
 				gperl_alloc_temp (sizeof (GArgument));
 			sv_to_arg (ST (i+OFFSET), temp, arg_type, may_be_null);
-			in_args[n_in_args++].v_pointer =
-				out_args[n_out_args++].v_pointer =
+			in_args[n_in_args].v_pointer =
+				out_args[n_out_args].v_pointer =
 					temp;
-			out_arg_type[n_out_args-1] = arg_type;
+			out_arg_type[n_out_args] = arg_type;
+			arg_types[i] = &ffi_type_pointer;
+			args[i] = &in_args[n_in_args];
+			n_in_args++;
+			n_out_args++;
 		    }
 			break;
 		}
 
-		g_base_info_unref ((GIBaseInfo*) arg_info);
+		g_base_info_unref ((GIBaseInfo *) arg_info);
 	}
 #undef OFFSET
 
-	/* if (n_in_args != have_args)
-		croak ("%s needs %d args, got %d",
-		       g_function_info_get_symbol (info),
-		       n_in_args, have_args); */
-
-	if (! g_function_info_invoke (info, in_args, n_in_args,
-				      out_args, n_out_args,
-				      &return_value, &error))
-		gperl_croak_gerror (NULL, error);
+#if 0
+	/*
+	 * This doesn't work for callback stuff, for example.  The C function
+	 * has (func, data, destroy_notify) whereas Perl only has (func, data).
+	 */
+	if (n_in_args != have_args)
+		croak ("%s needs %d args, got %d", symbol, n_in_args, have_args);
+#endif
+
+	/* find the return value type */
+	return_type_info = g_callable_info_get_return_type ((GICallableInfo *) info);
+	return_type_ffi = get_ffi_type (return_type_info);
+
+	/* prepare and call the function */
+	if (FFI_OK != ffi_prep_cif (&cif, FFI_DEFAULT_ABI, n_args,
+	   	      		    return_type_ffi, arg_types))
+	{
+		g_base_info_unref ((GIBaseInfo *) return_type_info);
+		croak ("Could not prepare a call interface for %s", symbol);
+	}
+
+	ffi_call (&cif, func_pointer, &return_value, args);
 
 	/*
 	 * place return value and output args on the stack
 	 */
-	return_type_info = g_callable_info_get_return_type ((GICallableInfo *) info);
-	return_type_transfer = g_callable_info_get_caller_owns ((GICallableInfo *) info);
 	has_return_value = GI_TYPE_TAG_VOID != g_type_info_get_tag (return_type_info);
-
 	if (has_return_value) {
+		GITransfer return_type_transfer =
+			g_callable_info_get_caller_owns ((GICallableInfo *) info);
 		SV *value = arg_to_sv (&return_value,
 		                       return_type_info,
 		                       return_type_transfer);