GNOME.org
 

[perl-Glib] Make the stack handling of some marshallers more robust

commit bf736478fa21541b1a162b99d95cc3cee160ba3c
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sat Jun 23 17:11:54 2012 +0200

    Make the stack handling of some marshallers more robust
    
    Specifically, correctly synchronize the local stack pointer with the one in
    thread-local storage.  This is mainly in preparation for custom Glib::Boxed
    converters that call back into Perl code, as Glib::Object::Introspection will
    provide.

 GBoxed.xs       |    7 ++++++-
 GClosure.xs     |    6 +++---
 GObject.xs      |    4 ++--
 GParamSpec.xs   |    2 ++
 GSignal.xs      |    5 +++--
 GType.xs        |   10 +++++-----
 GValue.xs       |   12 ++++++++++--
 NEWS            |    3 +++
 gperl-private.h |   19 +++++++++++++++++++
 gperl_marshal.h |    2 ++
 10 files changed, 55 insertions(+), 15 deletions(-)
---
diff --git a/GBoxed.xs b/GBoxed.xs
index 2a53c36..66d346a 100644
--- a/GBoxed.xs
+++ b/GBoxed.xs
@@ -442,6 +442,10 @@ the boxed structure should be destroyed when the wrapper is destroyed
 (controlled by I<own>; if the wrapper owns the object, the wrapper is in
 charge of destroying it's data).
 
+This function might end up calling other Perl code, so if you use it in XS code
+for a generic GType, make sure the stack pointer is set up correctly before the
+call, and restore it after the call.
+
 =cut
 SV *
 gperl_new_boxed (gpointer boxed,
@@ -815,7 +819,8 @@ copy (SV * sv)
 		       g_type_name (boxed_info->gtype), boxed_info->package);
 
 	boxed = class->unwrap (boxed_info->gtype, boxed_info->package, sv);
-	
+
+	/* No PUTBACK/SPAGAIN needed here. */
 	RETVAL = class->wrap (boxed_info->gtype, boxed_info->package, 
 	                      g_boxed_copy (boxed_info->gtype, boxed), TRUE);
     OUTPUT:
diff --git a/GClosure.xs b/GClosure.xs
index 56d10ae..988ad1a 100644
--- a/GClosure.xs
+++ b/GClosure.xs
@@ -122,8 +122,8 @@ gperl_closure_marshal (GClosure * closure,
 
 		/* the rest of the params should be quite straightforward. */
 		for (i = 1; i < n_param_values; i++) {
-			SV * arg;
-			arg = gperl_sv_from_value ((GValue*) param_values + i);
+			SV * arg = SAVED_STACK_SV (
+				gperl_sv_from_value ((GValue*) param_values + i));
 			/* make these mortal as they go onto the stack */
 			XPUSHs (sv_2mortal (arg));
 		}
@@ -488,7 +488,7 @@ gperl_callback_invoke (GPerlCallback * callback,
 				/* this won't return */
 				croak ("%s", SvPV_nolen (errstr));
 			}
-			sv = gperl_sv_from_value (&v);
+			sv = SAVED_STACK_SV (gperl_sv_from_value (&v));
 			g_value_unset (&v);
 			if (!sv) {
 				/* this should be very rare, too. */
diff --git a/GObject.xs b/GObject.xs
index adcdafe..53ee0cc 100644
--- a/GObject.xs
+++ b/GObject.xs
@@ -1403,8 +1403,8 @@ g_object_get (object, ...)
 	int i;
     CODE:
 	/* Use CODE: instead of PPCODE: so we can handle the stack ourselves in
-	 * order to avoid that xsubs called by g_object_get_property overwrite
-	 * what we put on the stack. */
+	 * order to avoid that xsubs called by g_object_get_property or
+	 * _gperl_sv_from_value_internal overwrite what we put on the stack. */
 	PERL_UNUSED_VAR (ix);
 	for (i = 1; i < items; i++) {
 		char *name = SvPV_nolen (ST (i));
diff --git a/GParamSpec.xs b/GParamSpec.xs
index 5da046d..718f2bd 100644
--- a/GParamSpec.xs
+++ b/GParamSpec.xs
@@ -755,6 +755,7 @@ get_default_value (GParamSpec * pspec)
 
 	} else {
 	plain_gvalue:
+	  /* No PUTBACK/SPAGAIN needed here. */
 	  RETVAL = gperl_sv_from_value (&v);
 	}
 	g_value_unset (&v);
@@ -809,6 +810,7 @@ g_param_value_validate (GParamSpec * pspec, SV *value)
 
 	    retcount = 2;
 	    if (modify)
+		/* No PUTBACK/SPAGAIN needed here. */
 		ST(1) = sv_2mortal (_gperl_sv_from_value_internal(&v,TRUE));
 	}
 	g_value_unset (&v);
diff --git a/GSignal.xs b/GSignal.xs
index c3ed3aa..c89562d 100644
--- a/GSignal.xs
+++ b/GSignal.xs
@@ -28,6 +28,7 @@
 /* #define NOISY */
 
 #include "gperl.h"
+#include "gperl-private.h" /* for SAVED_STACK_SV */
 
 /*
  * here's a nice G_LOCK-like front-end to GStaticRecMutex.  we need this 
@@ -663,7 +664,7 @@ g_signal_emit (instance, name, ...)
 		g_value_init (&ret, query.return_type);
 		g_signal_emitv (params, signal_id, detail, &ret);
 		EXTEND (SP, 1);
-		PUSHs (sv_2mortal (gperl_sv_from_value (&ret)));
+		SAVED_STACK_PUSHs (sv_2mortal (gperl_sv_from_value (&ret)));
 		g_value_unset (&ret);
 	} else {
 		g_signal_emitv (params, signal_id, detail, NULL);
@@ -1112,6 +1113,6 @@ g_signal_chain_from_overridden (GObject * instance, ...)
 	g_free (instance_and_params);
 
 	if (G_TYPE_NONE != (query.return_type & ~G_SIGNAL_TYPE_STATIC_SCOPE)) {
-		XPUSHs (sv_2mortal (gperl_sv_from_value (&return_value)));
+		SAVED_STACK_XPUSHs (sv_2mortal (gperl_sv_from_value (&return_value)));
 		g_value_unset (&return_value);
 	}
diff --git a/GType.xs b/GType.xs
index 78641ac..02e24a4 100644
--- a/GType.xs
+++ b/GType.xs
@@ -977,7 +977,7 @@ gperl_signal_class_closure_marshal (GClosure *closure,
 		 * objects. */
 		EXTEND (SP, (int)n_param_values);
 		for (i = 0; i < n_param_values; i++)
-			PUSHs (sv_2mortal (gperl_sv_from_value
+			SAVED_STACK_PUSHs (sv_2mortal (gperl_sv_from_value
 						((GValue*) &param_values[i])));
 
 		PUTBACK;
@@ -1091,8 +1091,8 @@ gperl_real_signal_accumulator (GSignalInvocationHint *ihint,
 	PUSHMARK (SP);
 
 	PUSHs (sv_2mortal (newSVGSignalInvocationHint (ihint)));
-	PUSHs (sv_2mortal (gperl_sv_from_value (return_accu)));
-	PUSHs (sv_2mortal (gperl_sv_from_value (handler_return)));
+	SAVED_STACK_PUSHs (sv_2mortal (gperl_sv_from_value (return_accu)));
+	SAVED_STACK_PUSHs (sv_2mortal (gperl_sv_from_value (handler_return)));
 
 	if (callback->data)
 		XPUSHs (callback->data);
@@ -1624,7 +1624,7 @@ gperl_type_set_property (GObject * object,
 		SAVETMPS;
 		PUSHMARK (SP);
 		PUSHs (sv_2mortal (gperl_new_object (object, FALSE)));
-		XPUSHs (sv_2mortal (gperl_sv_from_value (value)));
+		SAVED_STACK_XPUSHs (sv_2mortal (gperl_sv_from_value (value)));
 		PUTBACK;
 		call_sv (setter, G_VOID|G_DISCARD);
 		SPAGAIN;
@@ -1647,7 +1647,7 @@ gperl_type_set_property (GObject * object,
 		  PUSHMARK (SP);
 		  XPUSHs (sv_2mortal (gperl_new_object (object, FALSE)));
 		  XPUSHs (sv_2mortal (newSVGParamSpec (pspec)));
-		  XPUSHs (sv_2mortal (gperl_sv_from_value (value)));
+		  SAVED_STACK_XPUSHs (sv_2mortal (gperl_sv_from_value (value)));
 		  PUTBACK;
 
 		  call_sv ((SV *)GvCV (*slot), G_VOID|G_DISCARD);
diff --git a/GValue.xs b/GValue.xs
index 7eb6882..0243d2b 100644
--- a/GValue.xs
+++ b/GValue.xs
@@ -177,9 +177,13 @@ gperl_value_from_sv (GValue * value,
  * Coerce whatever is in I<value> into a perl scalar and return it.
  * If I<copy_boxed> is true, boxed values will be copied.  Values of type
  * GPERL_TYPE_SV are always copied (since that is merely a ref).
- * 
+ *
  * Croaks if the code doesn't know how to perform the conversion.
- * 
+ *
+ * Might end up calling other Perl code.  So if you use this function in XS
+ * code for a generic GType, make sure the stack pointer is set up correctly
+ * before the call, and restore it after the call.
+ *
  * =cut
  */
 SV *
@@ -304,6 +308,10 @@ Coerce whatever is in I<value> into a perl scalar and return it.
 
 Croaks if the code doesn't know how to perform the conversion.
 
+Might end up calling other Perl code.  So if you use this function in XS code
+for a generic GType, make sure the stack pointer is set up correctly before the
+call, and restore it after the call.
+
 =cut
 SV *
 gperl_sv_from_value (const GValue * value)
diff --git a/NEWS b/NEWS
index 06149b1..f3fd4e9 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,9 @@ Overview of changes in Glib <next>
 ==================================
 
 * Correctly handle the boxed type for GError.
+* Make the stack handling of some marshallers more robust, in
+  preparation for custom Glib::Boxed converters that call back into Perl
+  code.
 
 Overview of changes in Glib 1.261 (stable)
 ==========================================
diff --git a/gperl-private.h b/gperl-private.h
index 68f7ce0..d3c99b4 100644
--- a/gperl-private.h
+++ b/gperl-private.h
@@ -39,4 +39,23 @@ SV * _gperl_sv_from_value_internal (const GValue * value, gboolean copy_boxed);
 
 SV * _gperl_fetch_wrapper_key (GObject * object, const char * name, gboolean create);
 
+#define SAVED_STACK_SV(expr)			\
+	({					\
+		SV *_saved_stack_sv;		\
+		PUTBACK;			\
+		_saved_stack_sv = expr;		\
+		SPAGAIN;			\
+		_saved_stack_sv;		\
+	})
+#define SAVED_STACK_PUSHs(expr)					\
+	(void) ({						\
+		SV *_saved_stack_sv = SAVED_STACK_SV (expr);	\
+		PUSHs (_saved_stack_sv);			\
+	})
+#define SAVED_STACK_XPUSHs(expr)				\
+	(void) ({						\
+		SV *_saved_stack_sv = SAVED_STACK_SV (expr);	\
+		XPUSHs (_saved_stack_sv);			\
+	})
+
 #endif /* _GPERL_PRIVATE_H_ */
diff --git a/gperl_marshal.h b/gperl_marshal.h
index 23af292..6951a4d 100644
--- a/gperl_marshal.h
+++ b/gperl_marshal.h
@@ -126,6 +126,7 @@ This assumes that n_param_values > 1.
 */
 /* note -- keep an eye on the refcounts of instance and data! */
 #define GPERL_CLOSURE_MARSHAL_PUSH_INSTANCE(param_values)	\
+	PUTBACK;						\
 	if (GPERL_CLOSURE_SWAP_DATA (pc)) {			\
 		/* swap instance and data */			\
 		data     = gperl_sv_from_value (param_values);	\
@@ -135,6 +136,7 @@ This assumes that n_param_values > 1.
 		instance = gperl_sv_from_value (param_values);	\
 		data     = SvREFCNT_inc (pc->data);		\
 	}							\
+	SPAGAIN;						\
 	if (!instance)						\
 		instance = &PL_sv_undef;			\
 	/* the instance is always the first item in @_ */	\
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]