Author: cludwig Date: Fri Dec 12 12:10:03 2008 New Revision: 4 Log: preparations for the integration of reader-writer locks Added: trunk/trunk/src/threading/ (props changed) trunk/trunk/src/threading/reader-writer.lisp (contents, props changed) Modified: trunk/trunk/src/ (props changed) trunk/trunk/src/atom/ (props changed) trunk/trunk/src/external/ (props changed) trunk/trunk/src/isidorus.asd trunk/trunk/src/json/ (props changed) trunk/trunk/src/model/ (props changed) trunk/trunk/src/rest_interface/ (props changed) trunk/trunk/src/unit_tests/ (props changed) trunk/trunk/src/xml/ (props changed) Modified: trunk/trunk/src/isidorus.asd ============================================================================== --- trunk/trunk/src/isidorus.asd (original) +++ trunk/trunk/src/isidorus.asd Fri Dec 12 12:10:03 2008 @@ -113,7 +113,9 @@ "json")) (:module "json" :components ((:file "json_exporter")) - :depends-on ("model"))) + :depends-on ("model")) + (:module "threading" + :components ((:file "reader-writer")))) :depends-on (:cxml :drakma :elephant Added: trunk/trunk/src/threading/reader-writer.lisp ============================================================================== --- (empty file) +++ trunk/trunk/src/threading/reader-writer.lisp Fri Dec 12 12:10:03 2008 @@ -0,0 +1,56 @@ +(defpackage :isidorus-reader-writer + (:use :cl :hunchentoot-mp) + (:export :current-readers + :with-reader-lock + :with-writer-lock)) + +(in-package :isidorus-reader-writer) + +(defvar *readerlist-mutex* (make-lock "isidorus current-readers lock")) +(defvar *writer-mutex* (make-lock "isidorus writer lock")) + +(defvar *current-readers* nil) + +(defun current-readers () + (let + ((result nil)) + (with-lock (*readerlist-mutex*) + (setf result (copy-list *current-readers*))) + result)) + +(defun add-current-to-reader-list () + (with-lock (*writer-mutex*) + (with-lock (*readerlist-mutex*) + (push *current-process* *current-readers*)))) + +(defun remove-current-from-reader-list () + (with-lock (*readerlist-mutex*) + (setf *current-readers* + (delete *current-process* *current-readers*)))) + +(defmacro with-reader-lock (&body body) + `(progn + (add-current-to-reader-list) + (handler-case + (progn ,@body) + (condition (c) + (progn + (remove-current-from-reader-list) + (error c)))) + (remove-current-from-reader-list))) + + +(defmacro with-writer-lock (&body body) + `(with-lock (*writer-mutex*) + (do + ((remaining-readers (current-readers) (current-readers))) + ((nullp remaining-raeders) nil) + ;; TODO: replace hunchentoot's internal function by + ;; something we are officially allowed to use. + ;; make sure the current thread sleeps for, say, 500ms. + (hunchentoot::process-allow-scheduling())) + ,@body)) + + + + \ No newline at end of file