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.

And the patch...

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	24 Apr 2006 21:55:48 -0000
@@ -762,3 +762,28 @@
 ;;     (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))
+    (define-callback %enter-fn nil ()
+       (if (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*)
+ 	   (incf recursive-level)
+ 	(sb-thread:get-mutex *global-lock*)))
+
+    (define-callback %leave-fn nil ()
+       (if (zerop recursive-level)
+ 	  (sb-thread:release-mutex *global-lock*)
+ 	(decf recursive-level))))
+
+  (defbinding threads-set-lock-functions (&optional) nil
+    (%enter-fn callback)
+    (%leave-fn callback))
+
+  (defmacro with-global-lock (&body body)
+    `(sb-thread:with-mutex (*global-lock*)
+       ,@body)))
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	24 Apr 2006 21:55:49 -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."))
+    (prog1
+	(gdk:display-open display)
+      (sb-thread:make-thread 
+       #'(lambda () (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