[mcclim-cvs] CVS mcclim/Lisp-Dep

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep
In directory clnet:/tmp/cvs-serv11272/Lisp-Dep

Modified Files:
	mp-sbcl.lisp 
Log Message:
Move *all-processes* handling into the function passed to
SB-THREAD:MAKE-THREAD.


--- /project/mcclim/cvsroot/mcclim/Lisp-Dep/mp-sbcl.lisp	2008/05/29 19:11:28	1.12
+++ /project/mcclim/cvsroot/mcclim/Lisp-Dep/mp-sbcl.lisp	2008/05/29 19:11:45	1.13
@@ -48,7 +48,9 @@
    :function nil
    :thread sb-thread:*current-thread*))
 
-(defvar *all-processes* (list *current-process*))
+(defvar *all-processes* (list *current-process*)
+  "A list of processes created by McCLIM, plus the one that was
+running when this file was loaded.")
 
 (defvar *all-processes-lock*
   (sb-thread:make-mutex :name "Lock around *ALL-PROCESSES*"))
@@ -64,21 +66,21 @@
 
 (defun make-process (function &key name)
   (let ((p (%make-process :name name :function function)))
-    (sb-thread:with-mutex (*all-processes-lock*)
-      (pushnew p *all-processes*))
     (restart-process p)))
 
 (defun restart-process (p)
   (labels ((boing ()
 	     (let ((*current-process* p))
-	       (funcall (process-function p) ))))
+               (sb-thread:with-mutex (*all-processes-lock*)
+                 (pushnew p *all-processes*))
+	       (unwind-protect (funcall (process-function p))
+                 (sb-thread:with-mutex (*all-processes-lock*)
+                   (setf *all-processes* (delete p *all-processes*)))))))
     (when (process-thread p) (sb-thread:terminate-thread p))
     (when (setf (process-thread p) (sb-thread:make-thread #'boing :name (process-name p)))
       p)))
 
 (defun destroy-process (process)
-  (sb-thread:with-mutex (*all-processes-lock*)
-    (setf *all-processes* (delete process *all-processes*)))
   (sb-thread:terminate-thread (process-thread process)))
 
 (defun current-process ()
@@ -87,6 +89,8 @@
       (setf *current-process*
             (or (find sb-thread:*current-thread* *all-processes*
                  :key #'process-thread)
+                ;; Don't add this to *all-processes*, because we don't
+                ;; control it.
                 (%make-process
                  :name (sb-thread:thread-name sb-thread:*current-thread*)
                  :function nil