Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv11810/src/renderer

Modified Files: document.lisp Log Message:

Use Bordeaux Threads for all threading primitives, so that non-GUI parts of Closure don't have to depend on CLIM anymore.

- Removed all mp/ functions from glisp.

- Use condition variables instead of process-wait.

--- /project/closure/cvsroot/closure/src/renderer/document.lisp 2005/07/19 20:42:09 1.5 +++ /project/closure/cvsroot/closure/src/renderer/document.lisp 2006/12/31 15:42:41 1.6 @@ -39,8 +39,10 @@

;; list of all processes working for this document (processes :initform nil :accessor document-processes) - (processes/lock :initform (mp/make-lock :name "doc-proc-list Lock") + (processes/lock :initform (bordeaux-threads:make-lock "doc-proc-list Lock") :accessor document-processes/lock) ;this needs a lock + (processes/cv :initform (bordeaux-threads:make-condition-variable) + :accessor document-processes/cv) (processes-hooks ;; a list of hooks to call when ever the value of processes changes. :initform nil @@ -89,33 +91,44 @@ ;; Runs a process on behalf of a document, `continuation' is the ;; function to be run within the new process. ;; Returns the new process created. - (mp/with-lock ((document-processes/lock document)) + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) (let (new-process) (setf new-process - (mp/process-run-function - name + (bordeaux-threads:make-thread ;; << child (lambda () - (unwind-protect - (funcall continuation) - ;; remove myself from the list of processes - (progn - (mp/with-lock ((document-processes/lock document)) - (setf (document-processes document) - (delete new-process (document-processes document)))) ))) + (catch 'quit-dce-process + (unwind-protect + (funcall continuation) + ;; remove myself from the list of processes + (progn + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) + (setf (document-processes document) + (delete new-process (document-processes document))) + (bordeaux-threads:condition-notify + (document-processes/cv document))))))) ;; >> - )) + :name name)) ;; add new process to list of process (push new-process (document-processes document)) new-process)))

+;; bordeaux-threads says that kill-thread might not unwind cleanly. +;; Let's use interrupt-thread then. +(defun kill-dce-thread (thread) + (bordeaux-threads:interrupt-thread + thread + (lambda () (throw 'quit-dce-process nil)))) + (defun kill-all-document-processes (document) (setf (document-dead-p document) t) - (mp/with-lock ((document-processes/lock document)) - (mapc #'mp/process-kill (document-processes document))) - (mp/process-wait "Waiting for documents processes dying." - (lambda () - (null (document-processes document)))) + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) + (mapc #'kill-dce-thread (document-processes document))) + (loop + (bordeaux-threads:with-recursive-lock-held ((document-processes/lock document)) + (unless (document-processes document) + (return)) + (bordeaux-threads:condition-wait (document-processes/cv document)))) (values))

(defstruct image-entry