From cc052cb792265ed66f7154c358b721e11bd44d65 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Date: Wed, 23 Sep 2009 22:25:57 +0200
Subject: [PATCH] Added two new functions mp:lock-mine-p and mp:lock-count-mine
 which are used to implement mp:with-lock

---
 src/c/symbols_list.h  |  2 ++
 src/c/symbols_list2.h |  2 ++
 src/c/threads.d       | 18 ++++++++++++++++++
 src/h/external.h      |  2 ++
 src/lsp/mp.lsp        |  8 +++-----
 5 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 22775ceee..e8c3d803c 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1498,6 +1498,8 @@ cl_symbols[] = {
 {MP_ "LOCK-NAME", MP_ORDINARY, mp_lock_name, 1, OBJNULL},
 {MP_ "LOCK-HOLDER", MP_ORDINARY, mp_lock_holder, 1, OBJNULL},
 {MP_ "LOCK-COUNT", MP_ORDINARY, mp_lock_count, 1, OBJNULL},
+{MP_ "LOCK-MINE-P", MP_ORDINARY, mp_lock_mine_p, 1, OBJNULL},
+{MP_ "LOCK-COUNT-MINE", MP_ORDINARY, mp_lock_count_mine, 1, OBJNULL},
 {MP_ "GET-LOCK", MP_ORDINARY, mp_get_lock, -1, OBJNULL},
 {MP_ "GIVEUP-LOCK", MP_ORDINARY, mp_giveup_lock, 1, OBJNULL},
 {MP_ "MAKE-CONDITION-VARIABLE", MP_ORDINARY, mp_make_condition_variable, 0, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 6788a0c62..b6d740c84 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1498,6 +1498,8 @@ cl_symbols[] = {
 {MP_ "LOCK-NAME","mp_lock_name"},
 {MP_ "LOCK-HOLDER","mp_lock_holder"},
 {MP_ "LOCK-COUNT","mp_lock_count"},
+{MP_ "LOCK-MINE-P","mp_lock_mine_p"},
+{MP_ "LOCK-COUNT-MINE","mp_lock_count_mine"},
 {MP_ "GET-LOCK","mp_get_lock"},
 {MP_ "GIVEUP-LOCK","mp_giveup_lock"},
 {MP_ "MAKE-CONDITION-VARIABLE","mp_make_condition_variable"},
diff --git a/src/c/threads.d b/src/c/threads.d
index cac7cddc0..799693c85 100644
--- a/src/c/threads.d
+++ b/src/c/threads.d
@@ -579,6 +579,14 @@ mp_lock_holder(cl_object lock)
 	@(return lock->lock.holder)
 }
 
+cl_object
+mp_lock_mine_p(cl_object lock)
+{
+	if (type_of(lock) != t_lock)
+		FEwrong_type_argument(@'mp::lock', lock);
+	@(return ((lock->lock.holder == mp_current_process())? Ct : Cnil))
+}
+
 cl_object
 mp_lock_count(cl_object lock)
 {
@@ -587,6 +595,16 @@ mp_lock_count(cl_object lock)
 	@(return MAKE_FIXNUM(lock->lock.counter))
 }
 
+cl_object
+mp_lock_count_mine(cl_object lock)
+{
+	if (type_of(lock) != t_lock)
+		FEwrong_type_argument(@'mp::lock', lock);
+        @(return ((lock->lock.holder == mp_current_process())?
+                  MAKE_FIXNUM(lock->lock.counter) :
+                  MAKE_FIXNUM(0)))
+}
+
 cl_object
 mp_giveup_lock(cl_object lock)
 {
diff --git a/src/h/external.h b/src/h/external.h
index c71651e03..ea3f14468 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1610,7 +1610,9 @@ extern ECL_API cl_object mp_make_lock _ARGS((cl_narg narg, ...));
 extern ECL_API cl_object mp_recursive_lock_p(cl_object lock);
 extern ECL_API cl_object mp_lock_name(cl_object lock);
 extern ECL_API cl_object mp_lock_holder(cl_object lock);
+extern ECL_API cl_object mp_lock_mine_p(cl_object lock);
 extern ECL_API cl_object mp_lock_count(cl_object lock);
+extern ECL_API cl_object mp_lock_count_mine(cl_object lock);
 extern ECL_API cl_object mp_get_lock _ARGS((cl_narg narg, cl_object lock, ...));
 extern ECL_API cl_object mp_giveup_lock(cl_object lock);
 extern ECL_API cl_object mp_make_condition_variable(void);
diff --git a/src/lsp/mp.lsp b/src/lsp/mp.lsp
index c82cf3d91..b603a4cf1 100644
--- a/src/lsp/mp.lsp
+++ b/src/lsp/mp.lsp
@@ -117,15 +117,13 @@ by ALLOW-WITH-INTERRUPTS."
   ;; the get-lock statement, to ensure that the unlocking is done with
   ;; interrupts disabled.
   #+threads
-  (ext:with-unique-names (lock my-lock count interrupts)
+  (ext:with-unique-names (lock count interrupts)
     `(let* ((,lock ,lock-form)
-            (,my-lock (eq (mp:lock-holder ,lock) mp:*current-process*))
-            (,count (mp:lock-count ,lock)))
+            (,count (mp:lock-count-mine ,lock)))
        (without-interrupts
            (unwind-protect
                 (with-restored-interrupts
                     (mp::get-lock ,lock)
                   (locally ,@body))
-             (when (and (eq (mp:lock-holder ,lock) mp:*current-process*)
-                        (or (not ,my-lock) (> (mp:lock-count ,lock) ,count)))
+             (when (> (mp:lock-count-mine ,lock) ,count)
                (mp::giveup-lock ,lock)))))))