Commit 09c56b08 authored by Torsten Schönfeld's avatar Torsten Schönfeld

Prepare C → SV conversion code for calls back into Perl

interface_to_sv will soon start calling back into Perl, so any xsub invoking it
(directly or indirectly) needs to save the stack pointer via PUTBACK/SPAGAIN.

Currently, arg_to_sv and get_field are the only affected functions that are
called from xsubs.  We provide macros SS_arg_to_sv and SS_get_field that
automatically handle the stack pointer correctly.
parent 8c7f2dfd
......@@ -225,6 +225,18 @@ static void generic_class_init (GIObjectInfo *info, const gchar *target_package,
#define ccroak(...) call_carp_croak (form (__VA_ARGS__));
static void call_carp_croak (const char *msg);
/* interface_to_sv and its callers might invoke Perl code, so any xsub invoking
* them needs to save the stack. these wrappers do this automatically. */
#define SS_arg_to_sv(sv, arg, info, transfer, iinfo) \
PUTBACK; \
sv = arg_to_sv (arg, info, transfer, iinfo); \
SPAGAIN;
#define SS_get_field(sv, field_info, mem, transfer) \
PUTBACK; \
sv = get_field (field_info, mem, transfer); \
SPAGAIN;
/* #define NOISY */
#ifdef NOISY
# define dwarn(...) warn(__VA_ARGS__)
......@@ -423,7 +435,7 @@ _fetch_constant (class, basename, constant)
type_info = g_constant_info_get_type (info);
/* FIXME: What am I suppossed to do with the return value? */
g_constant_info_get_value (info, &value);
RETVAL = arg_to_sv (&value, type_info, GI_TRANSFER_NOTHING, NULL);
SS_arg_to_sv (RETVAL, &value, type_info, GI_TRANSFER_NOTHING, NULL);
#if GI_CHECK_VERSION (1, 30, 1)
g_constant_info_free_value (info, &value);
#endif
......@@ -459,7 +471,7 @@ _get_field (class, basename, namespace, field, invocant)
ccroak ("Unable to handle field access for type '%s'",
g_type_name (invocant_type));
boxed_mem = gperl_get_boxed_check (invocant, invocant_type);
RETVAL = get_field (field_info, boxed_mem, GI_TRANSFER_NOTHING);
SS_get_field (RETVAL, field_info, boxed_mem, GI_TRANSFER_NOTHING);
g_base_info_unref (field_info);
g_base_info_unref (namespace_info);
OUTPUT:
......
......@@ -49,6 +49,8 @@ store_fields (HV *fields, GIBaseInfo *info, GIInfoType info_type)
newRV_noinc ((SV *) av));
}
/* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
* PUTBACK/SPAGAIN by the caller. */
static SV *
get_field (GIFieldInfo *field_info, gpointer mem, GITransfer transfer)
{
......
......@@ -182,10 +182,12 @@ invoke_callable (GICallableInfo *info,
#endif
)
{
SV *value = arg_to_sv (&return_value,
iinfo.return_type_info,
iinfo.return_type_transfer,
&iinfo);
SV *value;
SS_arg_to_sv (value,
&return_value,
iinfo.return_type_info,
iinfo.return_type_transfer,
&iinfo);
if (value) {
XPUSHs (sv_2mortal (value));
n_return_values++;
......@@ -214,10 +216,11 @@ invoke_callable (GICallableInfo *info,
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);
SS_arg_to_sv (sv,
iinfo.out_args[i].v_pointer,
iinfo.out_arg_infos[i],
transfer,
&iinfo);
if (sv) {
XPUSHs (sv_2mortal (sv));
n_return_values++;
......
......@@ -75,7 +75,7 @@ invoke_callback (ffi_cif* cif, gpointer resp, gpointer* args, gpointer userdata)
GIArgument arg;
SV *sv;
raw_to_arg (args[i], &arg, arg_type);
sv = arg_to_sv (&arg, arg_type, transfer, &iinfo);
SS_arg_to_sv (sv, &arg, arg_type, transfer, &iinfo);
/* If arg_to_sv returns NULL, we take that as 'skip
* this argument'; happens for GDestroyNotify, for
* example. */
......
......@@ -128,6 +128,8 @@ sv_to_arg (SV * sv,
}
}
/* This may call Perl code (via interface_to_sv), so it needs to be wrapped
* with PUTBACK/SPAGAIN by the caller. */
static SV *
arg_to_sv (GIArgument * arg,
GITypeInfo * info,
......
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
/* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
* PUTBACK/SPAGAIN by the caller. */
static SV *
array_to_sv (GITypeInfo *info,
gpointer pointer,
......
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
/* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
* PUTBACK/SPAGAIN by the caller. */
static SV *
ghash_to_sv (GITypeInfo *info,
gpointer pointer,
......
......@@ -158,6 +158,8 @@ sv_to_interface (GIArgInfo * arg_info,
g_base_info_unref ((GIBaseInfo *) interface);
}
/* This may call Perl code, so it needs to be wrapped with PUTBACK/SPAGAIN by
* the caller. */
static SV *
interface_to_sv (GITypeInfo* info, GIArgument *arg, gboolean own, GPerlI11nInvocationInfo *iinfo)
{
......
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
/* This may call Perl code (via arg_to_sv), so it needs to be wrapped with
* PUTBACK/SPAGAIN by the caller. */
static SV *
glist_to_sv (GITypeInfo* info,
gpointer pointer,
......
/* -*- mode: c; indent-tabs-mode: t; c-basic-offset: 8; -*- */
/* This may call Perl code (via get_field), so it needs to be wrapped with
* PUTBACK/SPAGAIN by the caller. */
static SV *
struct_to_sv (GIBaseInfo* info,
GIInfoType info_type,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment