[perl-Glib-Object-Introspection] Prepare C â SV conversion code for calls back into Perl

[Torsten SchÃnfeld <tsch src gnome org>]

commit 09c56b08c9ed8c1176118739acc453d3e8f6dfa6
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sat May 12 18:27:37 2012 +0200

    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.

 GObjectIntrospection.xs        |   16 ++++++++++++++--
 gperl-i11n-field.c             |    2 ++
 gperl-i11n-invoke-c.c          |   19 +++++++++++--------
 gperl-i11n-invoke-perl.c       |    2 +-
 gperl-i11n-marshal-arg.c       |    2 ++
 gperl-i11n-marshal-array.c     |    2 ++
 gperl-i11n-marshal-hash.c      |    2 ++
 gperl-i11n-marshal-interface.c |    2 ++
 gperl-i11n-marshal-list.c      |    2 ++
 gperl-i11n-marshal-struct.c    |    2 ++
 10 files changed, 40 insertions(+), 11 deletions(-)
---
diff --git a/GObjectIntrospection.xs b/GObjectIntrospection.xs
index 431c4fa..95b6cdb 100644
--- a/GObjectIntrospection.xs
+++ b/GObjectIntrospection.xs
@@ -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:
diff --git a/gperl-i11n-field.c b/gperl-i11n-field.c
index 9cf1c43..e5880e4 100644
--- a/gperl-i11n-field.c
+++ b/gperl-i11n-field.c
@@ -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)
 {
diff --git a/gperl-i11n-invoke-c.c b/gperl-i11n-invoke-c.c
index fb2921c..e87056f 100644
--- a/gperl-i11n-invoke-c.c
+++ b/gperl-i11n-invoke-c.c
@@ -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++;
diff --git a/gperl-i11n-invoke-perl.c b/gperl-i11n-invoke-perl.c
index f44bd9c..d59139b 100644
--- a/gperl-i11n-invoke-perl.c
+++ b/gperl-i11n-invoke-perl.c
@@ -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. */
diff --git a/gperl-i11n-marshal-arg.c b/gperl-i11n-marshal-arg.c
index 5de46bd..c79fdf0 100644
--- a/gperl-i11n-marshal-arg.c
+++ b/gperl-i11n-marshal-arg.c
@@ -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,
diff --git a/gperl-i11n-marshal-array.c b/gperl-i11n-marshal-array.c
index 3607834..026245c 100644
--- a/gperl-i11n-marshal-array.c
+++ b/gperl-i11n-marshal-array.c
@@ -1,5 +1,7 @@
 /* -*- 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,
diff --git a/gperl-i11n-marshal-hash.c b/gperl-i11n-marshal-hash.c
index 92cedf6..cb940fc 100644
--- a/gperl-i11n-marshal-hash.c
+++ b/gperl-i11n-marshal-hash.c
@@ -1,5 +1,7 @@
 /* -*- 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,
diff --git a/gperl-i11n-marshal-interface.c b/gperl-i11n-marshal-interface.c
index 2dcca33..8017f66 100644
--- a/gperl-i11n-marshal-interface.c
+++ b/gperl-i11n-marshal-interface.c
@@ -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)
 {
diff --git a/gperl-i11n-marshal-list.c b/gperl-i11n-marshal-list.c
index 4c3cd40..416d603 100644
--- a/gperl-i11n-marshal-list.c
+++ b/gperl-i11n-marshal-list.c
@@ -1,5 +1,7 @@
 /* -*- 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,
diff --git a/gperl-i11n-marshal-struct.c b/gperl-i11n-marshal-struct.c
index 866c21f..680e2c7 100644
--- a/gperl-i11n-marshal-struct.c
+++ b/gperl-i11n-marshal-struct.c
@@ -1,5 +1,7 @@
 /* -*- 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,