[perl-Glib] Make signal marshalling more thread-safe

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

commit 6f1bc1a56e4c7c87d44caca1001cd50357f7a603
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sun May 15 17:45:58 2011 +0200

    Make signal marshalling more thread-safe
    
    When a signal that has Perl handlers is emitted from a non-main non-Perl
    thread, we used to simply use PERL_SET_CONTEXT to associate this thread
    with the main Perl interpreter.  But since it is not safe to call into
    one Perl interpreter concurrently, this does not work.
    
    Instead we now, upon noticing that we are being called from a thread
    without asoociated Perl interpreter, hand the marshalling request over
    to the main loop which in turn later wakes up the main thread and lets
    it handle the request.
    
    dGPERL_CLOSURE_MARSHAL_ARGS also needed to be adjusted not to use dSP
    since that dereferences the current thread's Perl interpreter without
    NULL check.
    
    https://bugzilla.gnome.org/show_bug.cgi?id=620099

 GClosure.xs     |   80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 NEWS            |   11 +++++++
 gperl_marshal.h |    5 ++-
 3 files changed, 94 insertions(+), 2 deletions(-)
---
diff --git a/GClosure.xs b/GClosure.xs
index ef0fd76..9caf354 100644
--- a/GClosure.xs
+++ b/GClosure.xs
@@ -61,6 +61,13 @@ gperl_closure_invalidate (gpointer data,
 	}
 }
 
+static void _closure_hand_to_main (GClosure * closure,
+                                   GValue * return_value,
+                                   guint n_param_values,
+                                   const GValue * param_values,
+                                   gpointer invocation_hint,
+                                   gpointer marshal_data);
+
 static void
 gperl_closure_marshal (GClosure * closure,
 		       GValue * return_value,
@@ -74,6 +81,23 @@ gperl_closure_marshal (GClosure * closure,
 	guint i;
 	dGPERL_CLOSURE_MARSHAL_ARGS;
 
+	/* If the current thread doesn't have a Perl context associated with
+	 * it, then we have no choice but to hand over everything to the main
+	 * thread and let it handle marshalling.
+	 *
+	 * We cannot simply use the main thread's Perl context here because the
+	 * Perl interpreter is not thread-safe.  For the same reason, we cannot
+	 * use perl_clone to create a new Perl interpreter from the main one.
+	 */
+	if (!PERL_GET_CONTEXT) {
+		g_printerr ("*** GPerl asked to invoke callback from a foreign thread; "
+		            "handing it over to the main loop\n");
+		_closure_hand_to_main (closure, return_value,
+		                       n_param_values, param_values,
+		                       invocation_hint, marshal_data);
+		return;
+	}
+
 	GPERL_CLOSURE_MARSHAL_INIT (closure, marshal_data);
 
 	PERL_UNUSED_VAR (invocation_hint);
@@ -120,6 +144,62 @@ gperl_closure_marshal (GClosure * closure,
 	LEAVE;
 }
 
+typedef struct {
+	GClosure * closure;
+	GValue * return_value;
+	guint n_param_values;
+	const GValue * param_values;
+	gpointer invocation_hint;
+	gpointer marshal_data;
+	GCond * done_cond;
+	GMutex * done_mutex;
+} MarshallerArgs;
+
+static gboolean
+_closure_remarshal (gpointer data)
+{
+	MarshallerArgs *args = data;
+	g_mutex_lock (args->done_mutex);
+		gperl_closure_marshal (args->closure,
+		                       args->return_value,
+		                       args->n_param_values,
+		                       args->param_values,
+		                       args->invocation_hint,
+		                       args->marshal_data);
+		g_cond_signal (args->done_cond);
+	g_mutex_unlock (args->done_mutex);
+	return FALSE;
+}
+
+static void
+_closure_hand_to_main (GClosure * closure,
+                       GValue * return_value,
+                       guint n_param_values,
+                       const GValue * param_values,
+                       gpointer invocation_hint,
+                       gpointer marshal_data)
+{
+	MarshallerArgs args;
+	args.closure = closure;
+	args.return_value = return_value;
+	args.n_param_values = n_param_values;
+	args.param_values = param_values;
+	args.invocation_hint = invocation_hint;
+	args.marshal_data = marshal_data;
+
+	/* We need to wait for the other thread to finish marshalling to avoid
+	 * gperl_closure_marshal returning prematurely. */
+	args.done_cond = g_cond_new ();
+	args.done_mutex = g_mutex_new ();
+	g_mutex_lock (args.done_mutex);
+		/* FIXME: Should we use a higher priority? */
+		g_idle_add (_closure_remarshal, &args);
+		g_cond_wait (args.done_cond, args.done_mutex);
+	g_mutex_unlock (args.done_mutex);
+
+	g_cond_free (args.done_cond);
+	g_mutex_free (args.done_mutex);
+}
 
 =item GClosure * gperl_closure_new (SV * callback, SV * data, gboolean swap)
 
diff --git a/NEWS b/NEWS
index 0fd25aa..6ee1ac5 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,14 @@
+Overview of changes in Glib <next>
+=================================
+
+* Make signal marshalling more thread-safe.  When a signal handler is invoked
+  from a foreign thread without asoociated Perl interpreter, hand the
+  marshalling over to the main loop which in turn later wakes up the main
+  thread and lets it handle the request.  Since this approach is experimental,
+  there is debug print for now whenever it is used:
+    *** GPerl asked to invoke callback from a foreign thread;
+        handing it over to the main loop
+
 Overview of changes in Glib 1.250
 =================================
 
diff --git a/gperl_marshal.h b/gperl_marshal.h
index a82b2a3..23af292 100644
--- a/gperl_marshal.h
+++ b/gperl_marshal.h
@@ -70,7 +70,7 @@ A typical marshaller skeleton will look like this:
 =item dGPERL_CLOSURE_MARSHAL_ARGS
 
 Declare several stack variables that the various GPERL_CLOSURE_MARSHAL macros
-will need.  Does C<dSP> for you.  This must go near the top of your C
+will need.  Declares C<SV ** sp> for you.  This must go near the top of your C
 function, before any code statements.
 
 =cut
@@ -80,7 +80,7 @@ function, before any code statements.
 	int count;		\
 	SV * data;		\
 	SV * instance;		\
-	dSP;
+	SV ** sp;
 
 /*
 =item GPERL_CLOSURE_MARSHAL_INIT (closure, marshal_data)
@@ -106,6 +106,7 @@ statement also initalizes C<pc> (the perl closure object) on the stack.
 
 # define GPERL_CLOSURE_MARSHAL_INIT(closure, marshal_data)	\
 	PERL_UNUSED_VAR (marshal_data);				\
+	SPAGAIN;						\
 	pc = (GPerlClosure *) closure;
 
 #endif