[bknr-cvs] r2177 - in branches/bos/bknr/src: data utils

[bknr at bknr.net]

Author: hhubner
Date: 2007-10-02 06:54:15 -0400 (Tue, 02 Oct 2007)
New Revision: 2177

Modified:
   branches/bos/bknr/src/data/txn.lisp
   branches/bos/bknr/src/utils/acl-mp-compat.lisp
   branches/bos/bknr/src/utils/package.lisp
Log:
SBCL compatibility patch contributed by oudeis


Modified: branches/bos/bknr/src/data/txn.lisp
===================================================================
--- branches/bos/bknr/src/data/txn.lisp	2007-10-02 10:53:43 UTC (rev 2176)
+++ branches/bos/bknr/src/data/txn.lisp	2007-10-02 10:54:15 UTC (rev 2177)
@@ -43,11 +43,11 @@
   ()
   (:default-initargs :guard (let ((lock (make-process-lock)))
 			      (lambda (thunk)
-				(mp-with-lock-held (lock)
+				(mp-with-recursive-lock-held (lock)
 				  (funcall thunk))))
                      :log-guard (let ((lock (make-process-lock)))
                                   (lambda (thunk)
-				    (mp-with-lock-held (lock)
+				    (mp-with-recursive-lock-held (lock)
 				      (funcall thunk)))))
   (:documentation
    "Store in which every transaction and operation is protected by a giant lock."))

Modified: branches/bos/bknr/src/utils/acl-mp-compat.lisp
===================================================================
--- branches/bos/bknr/src/utils/acl-mp-compat.lisp	2007-10-02 10:53:43 UTC (rev 2176)
+++ branches/bos/bknr/src/utils/acl-mp-compat.lisp	2007-10-02 10:54:15 UTC (rev 2177)
@@ -18,3 +18,14 @@
   #+cmu
   `(mp:with-lock-held (,lock)
     , at body))
+
+(defmacro mp-with-recursive-lock-held ((lock) &rest body)
+  #+allegro
+  `(mp:with-process-lock (,lock)
+    , at body)
+  #+sbcl
+  `(sb-thread:with-recursive-lock (,lock)
+     , at body)
+  #+cmu
+  `(mp:with-lock-held (,lock)
+    , at body))

Modified: branches/bos/bknr/src/utils/package.lisp
===================================================================
--- branches/bos/bknr/src/utils/package.lisp	2007-10-02 10:53:43 UTC (rev 2176)
+++ branches/bos/bknr/src/utils/package.lisp	2007-10-02 10:54:15 UTC (rev 2177)
@@ -147,6 +147,7 @@
 	   ;; mp compatibility
 	   #:mp-make-lock
 	   #:mp-with-lock-held
+	   #:mp-with-recursive-lock-held
 
 	   ;; class utils
 	   #:class-subclasses))