[isidorus-cvs] r4 - in trunk/trunk/src: . atom external json model rest_interface threading unit_tests xml

[Christoph Ludwig]

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 , at 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()))
+     , at body))
+
+
+     
+    
\ No newline at end of file