From 0badafcd35d1f0bd8aa17ffd9d1a7cb5dc6467a5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 5 Oct 2016 13:42:45 +0200
Subject: [PATCH] multiprocessing: add predicate "mp:holding-lock-p"

This predicate returns T if lock is hold by the process and NIL if it is
hold by another process or is released.
---
 src/c/symbols_list.h  |  1 +
 src/c/symbols_list2.h |  1 +
 src/c/threads/mutex.d | 10 ++++++++++
 src/h/external.h      |  1 +
 4 files changed, 13 insertions(+)

diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index eb81875b0..b3313de2b 100755
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1550,6 +1550,7 @@ cl_symbols[] = {
 {MP_ "MAKE-LOCK", MP_ORDINARY, IF_MP(mp_make_lock), -1, OBJNULL},
 {KEY_ "RECURSIVE", KEYWORD, NULL, -1, OBJNULL},
 {MP_ "RECURSIVE-LOCK-P", MP_ORDINARY, IF_MP(mp_recursive_lock_p), 1, OBJNULL},
+{MP_ "HOLDING-LOCK-P", MP_ORDINARY, IF_MP(mp_holding_lock_p), 1, OBJNULL},
 {MP_ "LOCK-NAME", MP_ORDINARY, IF_MP(mp_lock_name), 1, OBJNULL},
 {MP_ "LOCK-OWNER", MP_ORDINARY, IF_MP(mp_lock_owner), 1, OBJNULL},
 {MP_ "LOCK-COUNT", MP_ORDINARY, IF_MP(mp_lock_count), 1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index f59852bc7..32cee48ce 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1550,6 +1550,7 @@ cl_symbols[] = {
 {MP_ "MAKE-LOCK",IF_MP("mp_make_lock")},
 {KEY_ "RECURSIVE",NULL},
 {MP_ "RECURSIVE-LOCK-P",IF_MP("mp_recursive_lock_p")},
+{MP_ "HOLDING-LOCK-P",IF_MP("mp_holding_lock_p")},
 {MP_ "LOCK-NAME",IF_MP("mp_lock_name")},
 {MP_ "LOCK-OWNER",IF_MP("mp_lock_owner")},
 {MP_ "LOCK-COUNT",IF_MP("mp_lock_count")},
diff --git a/src/c/threads/mutex.d b/src/c/threads/mutex.d
index 30f3a3c84..c6899d023 100755
--- a/src/c/threads/mutex.d
+++ b/src/c/threads/mutex.d
@@ -67,6 +67,16 @@ mp_recursive_lock_p(cl_object lock)
   ecl_return1(env, lock->lock.recursive? ECL_T : ECL_NIL);
 }
 
+cl_object
+mp_holding_lock_p(cl_object lock)
+{
+  cl_env_ptr env = ecl_process_env();
+  cl_object own_process = env->own_process;
+  unlikely_if (ecl_t_of(lock) != t_lock)
+    FEerror_not_a_lock(lock);
+  ecl_return1(env, (lock->lock.owner == own_process) ? ECL_T : ECL_NIL);
+}
+
 cl_object
 mp_lock_name(cl_object lock)
 {
diff --git a/src/h/external.h b/src/h/external.h
index 48403d332..f5d8a87d5 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1776,6 +1776,7 @@ extern ECL_API cl_index ecl_atomic_index_incf(cl_index *slot);
 
 extern ECL_API cl_object mp_make_lock _ECL_ARGS((cl_narg narg, ...));
 extern ECL_API cl_object mp_recursive_lock_p(cl_object lock);
+extern ECL_API cl_object mp_holding_lock_p(cl_object lock);
 extern ECL_API cl_object mp_lock_name(cl_object lock);
 extern ECL_API cl_object mp_lock_owner(cl_object lock);
 extern ECL_API cl_object mp_lock_count(cl_object lock);