1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
static GPerlI11nPerlCallbackInfo *
create_perl_callback_closure (GITypeInfo *cb_type, SV *code)
{
GPerlI11nPerlCallbackInfo *info;
info = g_new0 (GPerlI11nPerlCallbackInfo, 1);
if (!gperl_sv_is_defined (code))
return info;
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;
#ifdef PERL_IMPLICIT_CONTEXT
info->priv = aTHX;
#endif
return info;
}
static void
attach_perl_callback_data (GPerlI11nPerlCallbackInfo *info, SV *data)
{
/* FIXME: SvREFCNT_inc? */
info->data = newSVsv (data);
}
/* assumes ownership of sub_name */
static GPerlI11nPerlCallbackInfo *
create_perl_callback_closure_for_named_sub (GITypeInfo *cb_type, gchar *sub_name)
{
GPerlI11nPerlCallbackInfo *info;
info = g_new0 (GPerlI11nPerlCallbackInfo, 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->code = NULL;
info->data = NULL;
#ifdef PERL_IMPLICIT_CONTEXT
info->priv = aTHX;
#endif
return info;
}
static void
release_perl_callback (gpointer data)
{
GPerlI11nPerlCallbackInfo *info = data;
dwarn ("releasing Perl 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);
g_free (info);
}
/* -------------------------------------------------------------------------- */
static GPerlI11nCCallbackInfo *
create_c_callback_closure (GIBaseInfo *interface, gpointer func)
{
GPerlI11nCCallbackInfo *info;
info = g_new0 (GPerlI11nCCallbackInfo, 1);
if (!func)
return info;
info->interface = interface;
g_base_info_ref (interface);
info->func = func;
return info;
}
static void
attach_c_callback_data (GPerlI11nCCallbackInfo *info, gpointer data)
{
info->data = data;
}
static void
release_c_callback (gpointer data)
{
GPerlI11nCCallbackInfo *info = data;
dwarn ("releasing C callback info %p\n", info);
/* FIXME: we cannot call the destroy notify here because it might be
* our own release_perl_callback which would try to free the ffi stuff
* that is currently running. */
/* if (info->destroy) */
/* info->destroy (info->data); */
if (info->interface)
g_base_info_unref (info->interface);
g_free (info);
}
|
