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