Re: threads/asynchronous I/O

Espen S Johnsen <[email protected]> writes:

> "Josh Bronson" <[email protected]> writes:
> 
> > Is there a way to write thread-safe applications using CLG? for example:
> > http://developer.gnome.org/doc/API/2.0/gdk/gdk-Threads.html
> > These functions don't seem to be bound anywhere in CLG.
> 
> I have been trying to get clg working with multi-threading, but without
> success so far. It seems to be working for a short time and then lock
> up. But I have included a patch that you may try to see if you have
> better luck than me. Use gtk:clg-init-with-threading for initialization
> and gdk:with-global-lock around any gtk call except in signal handlers.

After some more experimenting I think I have found the problem. The main
loop needs to run in the same thread as the one opening the display.
Included is a patch which fixes this problem and has a few other
improvements. Note that global data structures in glib are still
unprotected, which can cause problems if stuff related to the main loop
(eg. timers) are accessed from other threads.


Index: gdk/gdk.lisp
===================================================================
RCS file: /cvsroot/clg/clg/gdk/gdk.lisp,v
retrieving revision 1.25
diff -u -r1.25 gdk.lisp
--- gdk/gdk.lisp	11 Apr 2006 18:28:38 -0000	1.25
+++ gdk/gdk.lisp	25 Apr 2006 09:32:51 -0000
@@ -762,3 +762,40 @@
 ;;     (cr cairo:context)
 ;;     (region region))
 )
+
+
+;;; Multi-threading support
+
+#+sbcl
+(progn
+  (defvar *global-lock* (sb-thread:make-mutex :name "global GDK lock"))
+  (let ((recursive-level 0))
+    (defun threads-enter ()
+      (if (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*)
+	  (incf recursive-level)
+ 	(sb-thread:get-mutex *global-lock*)))
+
+    (defun threads-leave (&optional flush-p)
+      (cond
+       ((zerop recursive-level)	  
+	(when flush-p
+	  (display-flush))
+	(sb-thread:release-mutex *global-lock*))
+       (t (decf recursive-level)))))
+
+  (define-callback %enter-fn nil ()
+    (threads-enter))
+  
+  (define-callback %leave-fn nil ()
+    (threads-leave))
+  
+  (defbinding threads-set-lock-functions (&optional) nil
+    (%enter-fn callback)
+    (%leave-fn callback))
+
+  (defmacro with-global-lock (&body body)
+    `(progn
+       (threads-enter)
+       (unwind-protect
+	   (progn ,@body)
+	 (threads-leave t)))))
Index: gtk/gtk.lisp
===================================================================
RCS file: /cvsroot/clg/clg/gtk/gtk.lisp,v
retrieving revision 1.60
diff -u -r1.60 gtk.lisp
--- gtk/gtk.lisp	10 Apr 2006 18:56:19 -0000	1.60
+++ gtk/gtk.lisp	25 Apr 2006 09:32:51 -0000
@@ -73,6 +73,21 @@
       (setq *max-event-to-sec* 0)
       (setq *max-event-to-usec* 1000))))
 
+#+sbcl	  
+(defun clg-init-with-threading (&optional display)
+  "Initializes the system and starts the event handling"
+  (unless (gdk:display-get-default)
+    (gdk:gdk-init)
+    (gdk:threads-set-lock-functions)
+    (unless (gtk-init)
+      (error "Initialization of GTK+ failed."))
+    (sb-thread:make-thread 
+     #'(lambda () 
+	 (gdk:display-open display)
+	 (gdk:with-global-lock (main)))
+     :name "gtk event loop")))
+
+
 ;;; Generic functions 
 
 (defgeneric add-to-radio-group (item1 item2))


-- 
Espen


-------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642