? threadsafe.diff
Index: GBoxed.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GBoxed.xs,v
retrieving revision 1.3
diff -u -r1.3 GBoxed.xs
--- GBoxed.xs	26 May 2003 08:32:06 -0000	1.3
+++ GBoxed.xs	3 Jun 2003 17:06:34 -0000
@@ -21,7 +21,10 @@
 
 #include "gperl.h"
 
+static GPERL_STATIC_MUTEX info_by_gtype_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * info_by_gtype = NULL;
+
+static GPERL_STATIC_MUTEX info_by_package_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * info_by_package = NULL;
 
 typedef struct _BoxedInfo BoxedInfo;
@@ -66,6 +69,10 @@
 		      GPerlBoxedPackageFunc get_package)
 {
 	BoxedInfo * boxed_info;
+
+        GPERL_STATIC_MUTEX_LOCK(info_by_gtype_lock);
+        GPERL_STATIC_MUTEX_LOCK(info_by_package_lock);
+
 	if (!info_by_gtype) {
 		info_by_gtype = g_hash_table_new_full (g_direct_hash,
 						       g_direct_equal,
@@ -86,6 +93,9 @@
 	warn ("gperl_register_boxed (%d(%s), %s, %p)\n",
 	      gtype, g_type_name (gtype), package, get_package);
 #endif
+
+        GPERL_STATIC_MUTEX_UNLOCK(info_by_gtype_lock);
+        GPERL_STATIC_MUTEX_UNLOCK(info_by_package_lock);
 }
 
 GType
@@ -93,10 +103,15 @@
 {
 	BoxedInfo * boxed_info;
 
+        GPERL_STATIC_MUTEX_LOCK(info_by_package_lock);
+
 	boxed_info = (BoxedInfo*)
 		g_hash_table_lookup (info_by_package, package);
 	if (!boxed_info)
 		return 0;
+
+        GPERL_STATIC_MUTEX_UNLOCK(info_by_package_lock);
+
 	return boxed_info->gtype;
 }
 
@@ -105,10 +120,15 @@
 {
 	BoxedInfo * boxed_info;
 
+        GPERL_STATIC_MUTEX_LOCK(info_by_gtype_lock);
+
 	boxed_info = (BoxedInfo*)
 		g_hash_table_lookup (info_by_gtype, (gpointer)type);
 	if (!boxed_info)
 		return NULL;
+
+        GPERL_STATIC_MUTEX_UNLOCK(info_by_gtype_lock);
+
 	return boxed_info->package;
 }
 
@@ -179,9 +199,13 @@
 
 	boxed_wrapper = boxed_wrapper_new (boxed, gtype, own);
 
+        GPERL_STATIC_MUTEX_LOCK(info_by_gtype_lock);
+
 	boxed_info = (BoxedInfo*)
 		g_hash_table_lookup (info_by_gtype, (gpointer) gtype);
 
+        GPERL_STATIC_MUTEX_UNLOCK(info_by_gtype_lock);
+
 	if (!boxed_info)
 		croak ("GType %s (%d) is not registerer with gperl",
 		       g_type_name (gtype), gtype);
@@ -223,8 +247,13 @@
 	if (!boxed_wrapper)
 		croak ("internal nastiness: boxed wrapper contains NULL pointer");
 
+        GPERL_STATIC_MUTEX_LOCK(info_by_gtype_lock);
+
 	boxed_info = g_hash_table_lookup (info_by_gtype,
 	                                  (gpointer)gtype);
+
+        GPERL_STATIC_MUTEX_UNLOCK(info_by_gtype_lock);
+
 	if (!boxed_info)
 		croak ("internal problem: GType %s (%d) has not been registered with GPerl",
 			gtype, g_type_name (gtype));
Index: GObject.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GObject.xs,v
retrieving revision 1.3
diff -u -r1.3 GObject.xs
--- GObject.xs	1 Jun 2003 23:43:38 -0000	1.3
+++ GObject.xs	3 Jun 2003 17:06:34 -0000
@@ -24,14 +24,19 @@
 typedef struct _ClassInfo ClassInfo;
 
 struct _ClassInfo {
+        GPERL_MUTEX lock;
 	GType gtype;
 	const char * class;
-	char * package;
+	char * package;        
 };
 
+static GPERL_STATIC_MUTEX types_by_type_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * types_by_type = NULL;
+
+static GPERL_STATIC_MUTEX types_by_package_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * types_by_package = NULL;
 
+static GPERL_STATIC_MUTEX nowarn_by_type_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * nowarn_by_type = NULL;
 
 ClassInfo *
@@ -44,6 +49,7 @@
 	class_info->gtype = gtype;
 	class_info->class = g_type_name (gtype);
 	class_info->package = g_strdup (package);
+        class_info->lock = GPERL_MUTEX_NEW;
 
 	return class_info;
 }
@@ -55,6 +61,10 @@
 		/* do NOT free the class name */
 		if (class_info->package)
 			g_free (class_info->package);
+
+                if (class_info->lock)
+                        GPERL_MUTEX_FREE(class_info->lock);
+
 		g_free (class_info);
 	}
 }
@@ -70,22 +80,29 @@
 {
 	GType parent_type;
 	ClassInfo * class_info;
+
+        GPERL_STATIC_MUTEX_LOCK(types_by_type_lock);
+        GPERL_STATIC_MUTEX_LOCK(types_by_package_lock);
+
 	if (!types_by_type) {
 		/* we put the same data pointer into each hash table, so we
 		 * must only associate the destructor with one of them.
 		 * also, for the string-keyed hashes, the keys will be 
 		 * destroyed by the ClassInfo destructor, so we don't need
 		 * a key_destroy_func. */
+                
 		types_by_type = g_hash_table_new_full (g_direct_hash,
 						       g_direct_equal,
 						       NULL,
 						       (GDestroyNotify)
 						          class_info_destroy);
+
 		types_by_package = g_hash_table_new_full (g_str_hash,
 							  g_str_equal,
 							  NULL,
 							  NULL);
 	}
+
 	class_info = class_info_new (gtype, package);
 	g_hash_table_insert (types_by_type, (gpointer)class_info->gtype, class_info);
 	g_hash_table_insert (types_by_package, class_info->package, class_info);
@@ -93,6 +110,7 @@
 
 	parent_type = g_type_parent (gtype);
 	if (parent_type != 0) {
+                static GPERL_STATIC_MUTEX pending_lock = GPERL_STATIC_MUTEX_NEW;
 		static GList * pending_isa = NULL;
 		GList * i;
 
@@ -117,6 +135,8 @@
 		 * since this one is fresh we append it to the list, so that
 		 * we have a chance of registering its parent first.
 		 */
+                GPERL_STATIC_MUTEX_LOCK(pending_lock);
+
 		pending_isa = g_list_append (pending_isa, class_info);
 
 		/* handle whatever pending requests we can */
@@ -128,6 +148,8 @@
 			/* NOTE: reusing class_info --- it's not the same as
 			 * it was at the top of the function */
 			class_info = (ClassInfo*)(i->data);
+                        GPERL_MUTEX_LOCK(class_info->lock);
+
 			parent_package = gperl_object_package_from_type 
 					(g_type_parent (class_info->gtype));
 
@@ -146,29 +168,48 @@
 				/* go fish */
 				i = g_list_next (i);
 			}
+
+                        GPERL_MUTEX_UNLOCK(class_info->lock);
 		}
+
+                GPERL_STATIC_MUTEX_UNLOCK(pending_lock);
 	}
+
+        GPERL_STATIC_MUTEX_UNLOCK(types_by_type_lock);
+        GPERL_STATIC_MUTEX_UNLOCK(types_by_package_lock);
 }
 
 void
 gperl_object_set_no_warn_unreg_subclass (GType gtype,
                                          gboolean nowarn)
 {
+        GPERL_STATIC_MUTEX_LOCK(nowarn_by_type_lock);
+
 	if (!nowarn_by_type) {
 		if (!nowarn)
-			return;
-		nowarn_by_type = g_hash_table_new (g_direct_hash, g_direct_equal);
+			return;        
+		nowarn_by_type = g_hash_table_new (g_direct_hash, g_direct_equal);        
 	}
+
 	g_hash_table_insert (nowarn_by_type, (gpointer)gtype, (gpointer)nowarn);
+        GPERL_STATIC_MUTEX_UNLOCK(nowarn_by_type_lock);
 }
 
 static gboolean
 gperl_object_get_no_warn_unreg_subclass (GType gtype)
 {
+        gboolean result;
+
+        GPERL_STATIC_MUTEX_LOCK(nowarn_by_type_lock);
+
 	if (!nowarn_by_type)
 		return FALSE;
-	return (gboolean) g_hash_table_lookup (nowarn_by_type,
-	                                       (gpointer)gtype);
+
+        result = (gboolean)g_hash_table_lookup(nowarn_by_type, 
+                                               (gpointer)gtype);
+        GPERL_STATIC_MUTEX_UNLOCK(nowarn_by_type_lock);
+
+	return result;
 }
 
 /*
@@ -180,8 +221,14 @@
 {
 	if (types_by_type) {
 		ClassInfo * class_info;
+
+                GPERL_STATIC_MUTEX_LOCK(types_by_type_lock);
+
 		class_info = (ClassInfo *) 
 			g_hash_table_lookup (types_by_type, (gpointer)gtype);
+
+                GPERL_STATIC_MUTEX_UNLOCK(types_by_type_lock);
+
 		if (class_info)
 			return class_info->package;
 		else
@@ -199,8 +246,14 @@
 {
 	if (types_by_package) {
 		ClassInfo * class_info;
+
+                GPERL_STATIC_MUTEX_LOCK(types_by_package_lock);
+
 		class_info = (ClassInfo *) 
 			g_hash_table_lookup (types_by_package, package);
+
+                GPERL_STATIC_MUTEX_UNLOCK(types_by_package_lock);
+
 		if (class_info)
 			return class_info->gtype;
 		else
Index: GType.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/GType.xs,v
retrieving revision 1.4
diff -u -r1.4 GType.xs
--- GType.xs	31 May 2003 04:00:17 -0000	1.4
+++ GType.xs	3 Jun 2003 17:06:34 -0000
@@ -22,7 +22,10 @@
 #include "gperl.h"
 
 /* for fundamental types */
+static GPERL_STATIC_MUTEX types_by_package_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * types_by_package = NULL;
+
+static GPERL_STATIC_MUTEX packages_by_type_lock = GPERL_STATIC_MUTEX_NEW;
 static GHashTable * packages_by_type = NULL;
 
 
@@ -37,8 +40,11 @@
 gperl_type_class (GType type)
 {
 	static GQuark quark_static_class = 0;
+        static GPERL_STATIC_MUTEX quark_static_class_lock = GPERL_STATIC_MUTEX_NEW;
 	gpointer class;
 
+        GPERL_STATIC_MUTEX_LOCK(quark_static_class_lock);
+
 	if (!G_TYPE_IS_ENUM (type) && !G_TYPE_IS_FLAGS (type))
 		g_return_val_if_fail (G_TYPE_IS_OBJECT (type), NULL);
 
@@ -52,6 +58,8 @@
 		g_type_set_qdata (type, quark_static_class, class);
 	}
 
+        GPERL_STATIC_MUTEX_UNLOCK(quark_static_class_lock);
+
 	return class;
 }
 
@@ -296,6 +304,10 @@
 gperl_register_fundamental (GType gtype, const char * package)
 {
 	char * p;
+
+        GPERL_STATIC_MUTEX_LOCK(packages_by_type_lock);
+        GPERL_STATIC_MUTEX_LOCK(types_by_package_lock);
+
 	if (!types_by_package) {
 		types_by_package = 
 			g_hash_table_new_full (g_str_hash,
@@ -310,19 +322,38 @@
 	p = g_strdup (package);
 	g_hash_table_insert (packages_by_type, (gpointer)gtype, p);
 	g_hash_table_insert (types_by_package, p, (gpointer)gtype);
+
+        GPERL_STATIC_MUTEX_UNLOCK(packages_by_type_lock);
+        GPERL_STATIC_MUTEX_UNLOCK(types_by_package_lock);
 }
 
 GType
 gperl_fundamental_type_from_package (const char * package)
 {
-	return (GType) g_hash_table_lookup (types_by_package, package);
+        GType type;
+
+        GPERL_STATIC_MUTEX_LOCK(types_by_package_lock);
+
+        type = (GType) g_hash_table_lookup (types_by_package, package);
+
+        GPERL_STATIC_MUTEX_UNLOCK(types_by_package_lock);
+
+	return type;
 }
 
 const char * 
 gperl_fundamental_package_from_type (GType gtype)
 {
-	return (const char *)
-		g_hash_table_lookup (packages_by_type, (gpointer)gtype);
+        const char *package;
+
+        GPERL_STATIC_MUTEX_LOCK(packages_by_type_lock);
+
+        package =  (const char *)
+  		g_hash_table_lookup (packages_by_type, (gpointer)gtype);
+
+        GPERL_STATIC_MUTEX_UNLOCK(packages_by_type_lock);
+
+	return package;
 }
 
 
@@ -392,10 +423,18 @@
 gperl_sv_get_type (void)
 {
 	static GType sv_type = 0;
-	if (sv_type == 0)
+        static GPERL_STATIC_MUTEX sv_type_lock = GPERL_STATIC_MUTEX_NEW;
+
+        GPERL_STATIC_MUTEX_LOCK(sv_type_lock);
+
+	if (sv_type == 0) {
 		sv_type = g_boxed_type_register_static ("GPerlSV",
 		                                        (GBoxedCopyFunc) gperl_sv_copy,
 		                                        (GBoxedFreeFunc) gperl_sv_free);
+        }
+
+        GPERL_STATIC_MUTEX_UNLOCK(sv_type_lock);
+
 	return sv_type;
 }
 
@@ -540,6 +579,9 @@
 gperl_signal_class_closure_get(void)
 {
 	static GClosure *closure;
+        static GPERL_STATIC_MUTEX closure_lock = GPERL_STATIC_MUTEX_NEW;
+
+        GPERL_STATIC_MUTEX_LOCK(closure_lock);
 
 	if (closure == NULL) {
 		closure = g_closure_new_simple(sizeof(GClosure), NULL);
@@ -549,6 +591,9 @@
 		g_closure_ref (closure);
 		g_closure_sink (closure);
 	}
+
+        GPERL_STATIC_MUTEX_UNLOCK(closure_lock);
+
 	return closure;
 }
 
Index: Glib.xs
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/Glib.xs,v
retrieving revision 1.2
diff -u -r1.2 Glib.xs
--- Glib.xs	22 May 2003 14:23:11 -0000	1.2
+++ Glib.xs	3 Jun 2003 17:06:34 -0000
@@ -76,6 +76,7 @@
 
 BOOT:
 	g_type_init ();
+	g_thread_init(NULL);
 	/* boot all in one go.  other modules may not want to do it this
 	 * way, if they prefer instead to perform demand loading. */
 	GPERL_CALL_BOOT (boot_Glib__Type);
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/Makefile.PL,v
retrieving revision 1.1
diff -u -r1.1 Makefile.PL
--- Makefile.PL	17 May 2003 13:39:22 -0000	1.1
+++ Makefile.PL	3 Jun 2003 17:06:34 -0000
@@ -14,13 +14,14 @@
 mkdir 'build', 0777;
 
 %pkgcfg = Glib::PkgConfig->find ('gobject-2.0');
+%threadcfg = Glib::PkgConfig->find('gthread-2.0');
 
 $glib = ExtUtils::Depends->new ('Glib');
 # add -I. and -I./build to the include path so we can find our own files.
 # this will be inherited by dependant modules, so they can find their
 # generated files.
 $glib->set_inc ($pkgcfg{cflags} . ' -I. ');
-$glib->set_libs ($pkgcfg{libs});
+$glib->set_libs ($pkgcfg{libs} . " " . $threadcfg{libs});
 $glib->add_typemaps (cwd().'/typemap');
 $glib->add_headers ('"gperl.h"');
 $glib->install (qw(gperl.h));
Index: gperl.h
===================================================================
RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/gperl.h,v
retrieving revision 1.4
diff -u -r1.4 gperl.h
--- gperl.h	31 May 2003 04:00:45 -0000	1.4
+++ gperl.h	3 Jun 2003 17:06:35 -0000
@@ -26,11 +26,25 @@
 #include "perl.h"
 #include "XSUB.h"
 
+#include <glib.h>
 #include <glib-object.h>
 
 /*
  * miscellaneous
  */
+
+#define GPERL_MUTEX GMutex *
+#define GPERL_MUTEX_NEW g_mutex_new()
+#define GPERL_MUTEX_FREE(mutex) g_mutex_free(mutex)
+#define GPERL_MUTEX_LOCK(mutex) g_mutex_lock(mutex);
+#define GPERL_MUTEX_UNLOCK(mutex) g_mutex_unlock(mutex);
+#define GPERL_MUTEX_TRYLOCK(mutex) g_mutex_trylock(mutex)
+
+#define GPERL_STATIC_MUTEX GStaticRecMutex
+#define GPERL_STATIC_MUTEX_NEW G_STATIC_REC_MUTEX_INIT
+#define GPERL_STATIC_MUTEX_LOCK(mutex) g_static_rec_mutex_lock(&mutex)
+#define GPERL_STATIC_MUTEX_UNLOCK(mutex) g_static_rec_mutex_unlock(&mutex)
+#define GPERL_STATIC_MUTEX_TRYLOCK(mutex) g_static_rec_mutex_trylock(&mutex)
 
 /* 
  * never use this function directly.  see GPERL_CALL_BOOT, below.