Commit 5e32a372 authored by Torsten Schönfeld's avatar Torsten Schönfeld

Move most code into separate files

parent e1fb59a9
*.c
GObjectIntrospection.c
*.o
*.bs
Makefile
......
This diff is collapsed.
GObjectIntrospection.xs
gperl-i11n-callback.c
gperl-i11n-croak.c
gperl-i11n-field.c
gperl-i11n-gvalue.c
gperl-i11n-info.c
gperl-i11n-invoke-c.c
gperl-i11n-invoke-info.c
gperl-i11n-invoke-perl.c
gperl-i11n-marshal-arg.c
gperl-i11n-marshal-array.c
gperl-i11n-marshal-callback.c
gperl-i11n-marshal-hash.c
gperl-i11n-marshal-interface.c
gperl-i11n-marshal-list.c
gperl-i11n-marshal-raw.c
gperl-i11n-marshal-struct.c
gperl-i11n-method.c
gperl-i11n-size.c
gperl-i11n-vfunc-interface.c
gperl-i11n-vfunc-object.c
lib/Glib/Object/Introspection.pm
LICENSE
Makefile.PL
......@@ -9,6 +29,7 @@ perl-Glib-Object-Introspection.doap
README
t/00-basic-types.t
t/arrays.t
t/boxed.t
t/cairo-integration.t
t/callbacks.t
t/closures.t
......@@ -16,5 +37,8 @@ t/constants.t
t/enums.t
t/hashes.t
t/inc/setup.pl
t/interface-implementation.t
t/objects.t
t/structs.t
t/values.t
t/vfunc-implementation.t
......@@ -8,5 +8,5 @@ build
Makefile$
Makefile\.old$
MYMETA\..*$
\.c$
GObjectIntrospection.c$
\.o$
static GPerlI11nCallbackInfo *
create_callback_closure (GITypeInfo *cb_type, SV *code)
{
GPerlI11nCallbackInfo *info;
info = g_new0 (GPerlI11nCallbackInfo, 1);
info->interface =
(GICallableInfo *) g_type_info_get_interface (cb_type);
info->cif = g_new0 (ffi_cif, 1);
info->closure =
g_callable_info_prepare_closure (info->interface, info->cif,
invoke_callback, info);
/* FIXME: This should most likely use SvREFCNT_inc instead of
* newSVsv. */
info->code = newSVsv (code);
info->sub_name = NULL;
info->package_name = NULL;
#ifdef PERL_IMPLICIT_CONTEXT
info->priv = aTHX;
#endif
return info;
}
static void
attach_callback_data (GPerlI11nCallbackInfo *info, SV *data)
{
info->data = newSVsv (data);
}
/* assumes ownership of sub_name and package_name */
static GPerlI11nCallbackInfo *
create_callback_closure_for_named_sub (GITypeInfo *cb_type, gchar *sub_name, gchar *package_name)
{
GPerlI11nCallbackInfo *info;
info = g_new0 (GPerlI11nCallbackInfo, 1);
info->interface =
(GICallableInfo *) g_type_info_get_interface (cb_type);
info->cif = g_new0 (ffi_cif, 1);
info->closure =
g_callable_info_prepare_closure (info->interface, info->cif,
invoke_callback, info);
info->sub_name = sub_name;
info->package_name = package_name;
info->code = NULL;
info->data = NULL;
#ifdef PERL_IMPLICIT_CONTEXT
info->priv = aTHX;
#endif
return info;
}
static void
release_callback (gpointer data)
{
GPerlI11nCallbackInfo *info = data;
dwarn ("releasing callback info %p\n", info);
if (info->cif)
g_free (info->cif);
if (info->closure)
g_callable_info_free_closure (info->interface, info->closure);
if (info->interface)
g_base_info_unref ((GIBaseInfo*) info->interface);
if (info->code)
SvREFCNT_dec (info->code);
if (info->data)
SvREFCNT_dec (info->data);
if (info->sub_name)
g_free (info->sub_name);
if (info->package_name)
g_free (info->package_name);
g_free (info);
}
/* Call Carp's croak() so that errors are reported at their location in the
* user's program, not in Introspection.pm. Adapted from
* <http://www.perlmonks.org/?node_id=865159>. */
static void
call_carp_croak (const char *msg)
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
XPUSHs (sv_2mortal (newSVpv(msg, PL_na)));
PUTBACK;
call_pv("Carp::croak", G_VOID | G_DISCARD);
FREETMPS;
LEAVE;
}
static void
store_fields (HV *fields, GIBaseInfo *info, GIInfoType info_type)
{
const gchar *namespace;
AV *av;
gint i;
namespace = g_base_info_get_name (info);
av = newAV ();
switch (info_type) {
case GI_INFO_TYPE_BOXED:
case GI_INFO_TYPE_STRUCT:
{
gint n_fields = g_struct_info_get_n_fields (
(GIStructInfo *) info);
for (i = 0; i < n_fields; i++) {
GIFieldInfo *field_info;
const gchar *field_name;
field_info = g_struct_info_get_field ((GIStructInfo *) info, i);
field_name = g_base_info_get_name ((GIBaseInfo *) field_info);
av_push (av, newSVpv (field_name, PL_na));
g_base_info_unref ((GIBaseInfo *) field_info);
}
break;
}
case GI_INFO_TYPE_UNION:
{
gint n_fields = g_union_info_get_n_fields ((GIUnionInfo *) info);
for (i = 0; i < n_fields; i++) {
GIFieldInfo *field_info;
const gchar *field_name;
field_info = g_union_info_get_field ((GIUnionInfo *) info, i);
field_name = g_base_info_get_name ((GIBaseInfo *) field_info);
av_push (av, newSVpv (field_name, PL_na));
g_base_info_unref ((GIBaseInfo *) field_info);
}
break;
}
default:
ccroak ("store_fields: unsupported info type %d", info_type);
}
gperl_hv_take_sv (fields, namespace, strlen (namespace),
newRV_noinc ((SV *) av));
}
static SV *
get_field (GIFieldInfo *field_info, gpointer mem, GITransfer transfer)
{
GITypeInfo *field_type;
GIBaseInfo *interface_info;
GIArgument value;
SV *sv = NULL;
field_type = g_field_info_get_type (field_info);
interface_info = g_type_info_get_interface (field_type);
/* This case is not handled by g_field_info_set_field. */
if (!g_type_info_is_pointer (field_type) &&
g_type_info_get_tag (field_type) == GI_TYPE_TAG_INTERFACE &&
g_base_info_get_type (interface_info) == GI_INFO_TYPE_STRUCT)
{
gsize offset;
offset = g_field_info_get_offset (field_info);
value.v_pointer = mem + offset;
sv = arg_to_sv (&value,
field_type,
GI_TRANSFER_NOTHING,
NULL);
} else if (g_field_info_get_field (field_info, mem, &value)) {
sv = arg_to_sv (&value,
field_type,
transfer,
NULL);
} else {
ccroak ("Could not get field '%s'",
g_base_info_get_name (field_info));
}
if (interface_info)
g_base_info_unref (interface_info);
g_base_info_unref ((GIBaseInfo *) field_type);
return sv;
}
static void
set_field (GIFieldInfo *field_info, gpointer mem, GITransfer transfer, SV *value)
{
GITypeInfo *field_type;
GIBaseInfo *interface_info;
GIArgument arg;
field_type = g_field_info_get_type (field_info);
interface_info = g_type_info_get_interface (field_type);
/* FIXME: No GIArgInfo and no
* GPerlI11nInvocationInfo here. What if the
* struct contains an object pointer, or a
* callback field? And is it OK to always
* allow undef? */
/* This case is not handled by g_field_info_set_field. */
if (!g_type_info_is_pointer (field_type) &&
g_type_info_get_tag (field_type) == GI_TYPE_TAG_INTERFACE &&
g_base_info_get_type (interface_info) == GI_INFO_TYPE_STRUCT)
{
gsize offset;
gssize size;
/* Enforce GI_TRANSFER_NOTHING since we will copy into the
* memory that has already been allocated inside 'mem' */
sv_to_arg (value, &arg, NULL, field_type,
GI_TRANSFER_NOTHING, TRUE, NULL);
offset = g_field_info_get_offset (field_info);
size = g_struct_info_get_size (interface_info);
g_memmove (mem + offset, arg.v_pointer, size);
} else {
sv_to_arg (value, &arg, NULL, field_type,
transfer, TRUE, NULL);
if (!g_field_info_set_field (field_info, mem, &arg))
ccroak ("Could not set field '%s'",
g_base_info_get_name (field_info));
}
if (interface_info)
g_base_info_unref (interface_info);
g_base_info_unref (field_type);
}
/* Semi-private package for marshalling into GValues. */
#define GVALUE_WRAPPER_PACKAGE "Glib::Object::Introspection::GValueWrapper"
static GValue *
SvGValueWrapper (SV *sv)
{
return sv_derived_from (sv, GVALUE_WRAPPER_PACKAGE)
? INT2PTR (GValue*, SvIV (SvRV (sv)))
: NULL;
}
static SV *
newSVGValueWrapper (GValue *v)
{
SV *sv;
sv = newSV (0);
sv_setref_pv (sv, GVALUE_WRAPPER_PACKAGE, v);
return sv;
}
/* Caller owns return value */
static GIFunctionInfo *
get_function_info (GIRepository *repository,
const gchar *basename,
const gchar *namespace,
const gchar *method)
{
dwarn ("%s: %s, %s, %s\n", G_STRFUNC, basename, namespace, method);
if (namespace) {
GIFunctionInfo *function_info = NULL;
GIBaseInfo *namespace_info = g_irepository_find_by_name (
repository, basename, namespace);
if (!namespace_info)
ccroak ("Can't find information for namespace %s",
namespace);
switch (g_base_info_get_type (namespace_info)) {
case GI_INFO_TYPE_OBJECT:
function_info = g_object_info_find_method (
(GIObjectInfo *) namespace_info,
method);
break;
case GI_INFO_TYPE_INTERFACE:
function_info = g_interface_info_find_method (
(GIInterfaceInfo *) namespace_info,
method);
break;
case GI_INFO_TYPE_BOXED:
case GI_INFO_TYPE_STRUCT:
function_info = g_struct_info_find_method (
(GIStructInfo *) namespace_info,
method);
break;
case GI_INFO_TYPE_UNION:
function_info = g_union_info_find_method (
(GIUnionInfo *) namespace_info,
method);
break;
default:
ccroak ("Base info for namespace %s has incorrect type",
namespace);
}
if (!function_info)
ccroak ("Can't find information for method "
"%s::%s", namespace, method);
g_base_info_unref (namespace_info);
return function_info;
} else {
GIBaseInfo *method_info = g_irepository_find_by_name (
repository, basename, method);
if (!method_info)
ccroak ("Can't find information for method %s", method);
switch (g_base_info_get_type (method_info)) {
case GI_INFO_TYPE_FUNCTION:
return (GIFunctionInfo *) method_info;
default:
ccroak ("Base info for method %s has incorrect type",
method);
}
}
return NULL;
}
/* Caller owns return value */
static GIFieldInfo *
get_field_info (GIBaseInfo *info, const gchar *field_name)
{
GIInfoType info_type;
info_type = g_base_info_get_type (info);
switch (info_type) {
case GI_INFO_TYPE_BOXED:
case GI_INFO_TYPE_STRUCT:
{
gint n_fields, i;
n_fields = g_struct_info_get_n_fields ((GIStructInfo *) info);
for (i = 0; i < n_fields; i++) {
GIFieldInfo *field_info;
field_info = g_struct_info_get_field ((GIStructInfo *) info, i);
if (0 == strcmp (field_name, g_base_info_get_name (field_info))) {
return field_info;
}
g_base_info_unref (field_info);
}
break;
}
case GI_INFO_TYPE_UNION:
{
gint n_fields, i;
n_fields = g_union_info_get_n_fields ((GIStructInfo *) info);
for (i = 0; i < n_fields; i++) {
GIFieldInfo *field_info;
field_info = g_union_info_get_field ((GIStructInfo *) info, i);
if (0 == strcmp (field_name, g_base_info_get_name (field_info))) {
return field_info;
}
g_base_info_unref (field_info);
}
break;
}
default:
break;
}
return NULL;
}
void
invoke_callable (GICallableInfo *info,
gpointer func_pointer,
SV **sp, I32 ax, SV **mark, I32 items, /* these correspond to dXSARGS */
UV internal_stack_offset)
{
ffi_cif cif;
gpointer instance = NULL;
guint i;
GPerlI11nInvocationInfo iinfo = {0,};
guint n_return_values;
GIArgument return_value;
GError * local_error = NULL;
gpointer local_error_address = &local_error;
PERL_UNUSED_VAR (mark);
prepare_invocation_info (&iinfo, info, items, internal_stack_offset);
if (iinfo.is_method) {
instance = instance_sv_to_pointer (info, ST (0 + iinfo.stack_offset));
iinfo.arg_types[0] = &ffi_type_pointer;
iinfo.args[0] = &instance;
}
for (i = 0 ; i < iinfo.n_args ; i++) {
GIArgInfo * arg_info;
GITypeInfo * arg_type;
GITransfer transfer;
gboolean may_be_null;
gint perl_stack_pos, ffi_stack_pos;
SV *current_sv;
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 */
arg_type = g_arg_info_get_type (arg_info);
transfer = g_arg_info_get_ownership_transfer (arg_info);
may_be_null = g_arg_info_may_be_null (arg_info);
perl_stack_pos = i
+ iinfo.method_offset
+ iinfo.stack_offset
+ iinfo.dynamic_stack_offset;
ffi_stack_pos = i
+ iinfo.method_offset;
/* FIXME: Is this right? I'm confused about the relation of
* the numbers in g_callable_info_get_arg and
* g_arg_info_get_closure and g_arg_info_get_destroy. We used
* to add method_offset, but that stopped being correct at some
* point. */
iinfo.current_pos = i; /* + method_offset; */
dwarn (" arg %d, tag: %d (%s), is_pointer: %d, is_automatic: %d\n",
i,
g_type_info_get_tag (arg_type),
g_type_tag_to_string (g_type_info_get_tag (arg_type)),
g_type_info_is_pointer (arg_type),
iinfo.is_automatic_arg[i]);
/* FIXME: Generate a proper usage message if the user did not
* supply enough arguments. */
current_sv = perl_stack_pos < items ? ST (perl_stack_pos) : &PL_sv_undef;
switch (g_arg_info_get_direction (arg_info)) {
case GI_DIRECTION_IN:
if (iinfo.is_automatic_arg[i]) {
iinfo.dynamic_stack_offset--;
#if GI_CHECK_VERSION (1, 29, 0)
} else if (g_arg_info_is_skip (arg_info)) {
iinfo.dynamic_stack_offset--;
#endif
} else {
sv_to_arg (current_sv,
&iinfo.in_args[i], arg_info, arg_type,
transfer, may_be_null, &iinfo);
}
iinfo.arg_types[ffi_stack_pos] =
g_type_info_get_ffi_type (arg_type);
iinfo.args[ffi_stack_pos] = &iinfo.in_args[i];
g_base_info_unref ((GIBaseInfo *) arg_type);
break;
case GI_DIRECTION_OUT:
if (g_arg_info_is_caller_allocates (arg_info)) {
iinfo.aux_args[i].v_pointer =
allocate_out_mem (arg_type);
iinfo.out_args[i].v_pointer = &iinfo.aux_args[i];
iinfo.args[ffi_stack_pos] = &iinfo.aux_args[i];
} else {
iinfo.out_args[i].v_pointer = &iinfo.aux_args[i];
iinfo.args[ffi_stack_pos] = &iinfo.out_args[i];
}
iinfo.out_arg_infos[i] = arg_type;
iinfo.arg_types[ffi_stack_pos] = &ffi_type_pointer;
/* Adjust the dynamic stack offset so that this out
* argument doesn't inadvertedly eat up an in argument. */
iinfo.dynamic_stack_offset--;
break;
case GI_DIRECTION_INOUT:
iinfo.in_args[i].v_pointer =
iinfo.out_args[i].v_pointer =
&iinfo.aux_args[i];
if (iinfo.is_automatic_arg[i]) {
iinfo.dynamic_stack_offset--;
#if GI_CHECK_VERSION (1, 29, 0)
} else if (g_arg_info_is_skip (arg_info)) {
iinfo.dynamic_stack_offset--;
#endif
} else {
/* We pass iinfo.in_args[i].v_pointer here,
* not &iinfo.in_args[i], so that the value
* pointed to is filled from the SV. */
sv_to_arg (current_sv,
iinfo.in_args[i].v_pointer, arg_info, arg_type,
transfer, may_be_null, &iinfo);
}
iinfo.out_arg_infos[i] = arg_type;
iinfo.arg_types[ffi_stack_pos] = &ffi_type_pointer;
iinfo.args[ffi_stack_pos] = &iinfo.in_args[i];
break;
}
g_base_info_unref ((GIBaseInfo *) arg_info);
}
/* do another pass to handle automatic args */
for (i = 0 ; i < iinfo.n_args ; i++) {
GIArgInfo * arg_info;
if (!iinfo.is_automatic_arg[i])
continue;
arg_info = g_callable_info_get_arg ((GICallableInfo *) info, i);
switch (g_arg_info_get_direction (arg_info)) {
case GI_DIRECTION_IN:
handle_automatic_arg (i, &iinfo.in_args[i], &iinfo);
break;
case GI_DIRECTION_INOUT:
handle_automatic_arg (i, &iinfo.aux_args[i], &iinfo);
break;
case GI_DIRECTION_OUT:
/* handled later */
break;
}
g_base_info_unref ((GIBaseInfo *) arg_info);
}
if (iinfo.throws) {
iinfo.args[iinfo.n_invoke_args - 1] = &local_error_address;
iinfo.arg_types[iinfo.n_invoke_args - 1] = &ffi_type_pointer;
}
/* prepare and call the function */
if (FFI_OK != ffi_prep_cif (&cif, FFI_DEFAULT_ABI, iinfo.n_invoke_args,
iinfo.return_type_ffi, iinfo.arg_types))
{
clear_invocation_info (&iinfo);
ccroak ("Could not prepare a call interface");
}
ffi_call (&cif, func_pointer, &return_value, iinfo.args);
/* free call-scoped callback infos */
g_slist_foreach (iinfo.free_after_call,
(GFunc) release_callback, NULL);
if (local_error) {
gperl_croak_gerror (NULL, local_error);
}
/*
* handle return values
*/
n_return_values = 0;
/* place return value and output args on the stack */
if (iinfo.has_return_value
#if GI_CHECK_VERSION (1, 29, 0)
&& !g_callable_info_skip_return ((GICallableInfo *) info)
#endif
)
{
SV *value = arg_to_sv (&return_value,
iinfo.return_type_info,
iinfo.return_type_transfer,
&iinfo);
if (value) {
XPUSHs (sv_2mortal (value));
n_return_values++;
}
}
/* out args */
for (i = 0 ; i < iinfo.n_args ; i++) {
GIArgInfo * arg_info;
if (iinfo.is_automatic_arg[i])
continue;
arg_info = g_callable_info_get_arg ((GICallableInfo *) info, i);
#if GI_CHECK_VERSION (1, 29, 0)
if (g_arg_info_is_skip (arg_info)) {
g_base_info_unref ((GIBaseInfo *) arg_info);
continue;
}
#endif
switch (g_arg_info_get_direction (arg_info)) {
case GI_DIRECTION_OUT:
case GI_DIRECTION_INOUT:
{
GITransfer transfer;
SV *sv;
/* If we allocated the memory ourselves, we always own it. */
transfer = g_arg_info_is_caller_allocates (arg_info)
? GI_TRANSFER_CONTAINER
: g_arg_info_get_ownership_transfer (arg_info);
sv = arg_to_sv (iinfo.out_args[i].v_pointer,
iinfo.out_arg_infos[i],
transfer,
&iinfo);
if (sv) {
XPUSHs (sv_2mortal (sv));
n_return_values++;
}
g_base_info_unref ((GIBaseInfo*) iinfo.out_arg_infos[i]);
break;
}
default:
break;
}
g_base_info_unref ((GIBaseInfo *) arg_info);
}
clear_invocation_info (&iinfo);
dwarn (" number of return values: %d\n", n_return_values);
PUTBACK;
}
static void
prepare_invocation_info (GPerlI11nInvocationInfo *iinfo,
GICallableInfo *info,
IV items,
UV internal_stack_offset)
{
gboolean is_vfunc;
guint i;
is_vfunc = GI_IS_VFUNC_INFO (info);
iinfo->stack_offset = internal_stack_offset;
iinfo->is_constructor = is_vfunc
? FALSE
: g_function_info_get_flags (info) & GI_FUNCTION_IS_CONSTRUCTOR;
if (iinfo->is_constructor) {
iinfo->stack_offset++;
}
iinfo->n_given_args = items - iinfo->stack_offset;
iinfo->n_invoke_args = iinfo->n_args =
g_callable_info_get_n_args ((GICallableInfo *) info);
/* FIXME: can a vfunc not throw? */
iinfo->throws = is_vfunc
? FALSE
: g_function_info_get_flags (info) & GI_FUNCTION_THROWS;
if (iinfo->throws) {
iinfo->n_invoke_args++;
}
if (is_vfunc) {
iinfo->is_method = TRUE;
} else {
iinfo->is_method =
(g_function_info_get_flags (info) & GI_FUNCTION_IS_METHOD)
&& !iinfo->is_constructor;
}
if (iinfo->is_method) {
iinfo->n_invoke_args++;
}
dwarn ("invoke: %s\n"
" n_args: %d, n_invoke_args: %d, n_given_args: %d\n"
" is_constructor: %d, is_method: %d\n",
is_vfunc ? g_base_info_get_name (info) : g_function_info_get_symbol (info),
iinfo->n_args, iinfo->n_invoke_args, iinfo->n_given_args,
iinfo->is_constructor, iinfo->is_method);
iinfo->return_type_info =
g_callable_info_get_return_type ((GICallableInfo *) info);
iinfo->has_return_value =
GI_TYPE_TAG_VOID != g_type_info_get_tag (iinfo->return_type_info);
iinfo->return_type_ffi = g_type_info_get_ffi_type (iinfo->return_type_info);
iinfo->return_type_transfer = g_callable_info_get_caller_owns ((GICallableInfo *) info);
/* allocate enough space for all args in both the out and in lists.
* we'll only use as much as we need. since function argument lists
* are typically small, this shouldn't be a big problem. */
if (iinfo->n_invoke_args) {
gint n = iinfo->n_invoke_args;
iinfo->in_args = gperl_alloc_temp (sizeof (GIArgument) * n);
iinfo->out_args = gperl_alloc_temp (sizeof (GIArgument) * n);
iinfo->out_arg_infos = gperl_alloc_temp (sizeof (GITypeInfo*) * n);
iinfo->arg_types = gperl_alloc_temp (sizeof (ffi_type *) * n);
iinfo->args = gperl_alloc_temp (sizeof (gpointer) * n);
iinfo->aux_args = gperl_alloc_temp (sizeof (GIArgument) * n);
iinfo->is_automatic_arg = gperl_alloc_temp (sizeof (gboolean) * n);
}
iinfo->method_offset = iinfo->is_method ? 1 : 0;