klisp

commit f1ed54d9fa77c9378fc035dda595646e43f0535d
parent 44ee75643ede8c2cc39b70bc2cf7e03254bb0e11
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 29 Aug 2012 17:49:20 -0300

Added mutex lock, unlock, and trylock.

Diffstat:
M
src/kgthreads.c
 | 
57
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/kmutex.c
 | 
86
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/kmutex.h
 | 
19
+++++++++++++------

3 files changed, 156 insertions(+), 6 deletions(-)
diff --git a/src/kgthreads.c b/src/kgthreads.c
@@ -39,6 +39,9 @@ static void *thread_run(void *data)
 routine somewhere */
     bool errorp = false; /* may be set to true in error handler */
     bool rootp = true; /* may be set to false in continuation */
+
+    /* ???/TODO should the fact that the thread thrown an exception
+       be reported to the error output??? */
     
     /* We have already the appropriate environment,
        operative and arguments in place, but we still need the 
@@ -165,6 +168,52 @@ static void make_mutex(klisp_State *K)
     kapply_cc(K, new_mutex);
 }
 
+/* mutex-lock */
+static void mutex_lock(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_1tp(K, ptree, "mutex", ttismutex, mutex);
+    kmutex_lock(K, mutex);
+    kapply_cc(K, KINERT);
+}
+
+/* mutex-unlock */
+static void mutex_unlock(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_1tp(K, ptree, "mutex", ttismutex, mutex);
+    kmutex_unlock(K, mutex);
+    kapply_cc(K, KINERT);
+}
+
+/* mutex-trylock */
+static void mutex_trylock(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_1tp(K, ptree, "mutex", ttismutex, mutex);
+    bool res = kmutex_trylock(K, mutex);
+    kapply_cc(K, b2tv(res));
+}
+
+
 /* init ground */
 void kinit_threads_ground_env(klisp_State *K)
 {
@@ -193,4 +242,12 @@ void kinit_threads_ground_env(klisp_State *K)
 
     /* make-mutex */
     add_applicative(K, ground_env, "make-mutex", make_mutex, 0);
+    /* REFACTOR: should lock and unlock have an '!'?
+       What about try lock?? '!', '?', '!?', neither?
+    /* mutex-lock */
+    add_applicative(K, ground_env, "mutex-lock", mutex_lock, 0);
+    /* mutex-unlock */
+    add_applicative(K, ground_env, "mutex-unlock", mutex_unlock, 0);
+    /* mutex-trylock */
+    add_applicative(K, ground_env, "mutex-trylock", mutex_trylock, 0);
 }
diff --git a/src/kmutex.c b/src/kmutex.c
@@ -35,6 +35,92 @@ TValue kmake_mutex(klisp_State *K)
     return gc2mutex(new_mutex);
 }
 
+/* LOCK: GIL should be acquired exactly once */
+void kmutex_lock(klisp_State *K, TValue mutex)
+{
+    TValue thread = gc2th(K);
+    if (tv_equal(thread, kmutex_owner(mutex))) {
+        if (kmutex_count(mutex) == KMUTEX_MAX_COUNT) {
+            klispE_throw_simple(K, "Mutex count overflow");
+            return;
+        }
+        ++kmutex_count(mutex);
+    } else {
+        /* we need to release GIL to avoid deadlocks */
+        klisp_unlock(K);
+        int res = pthread_mutex_lock(&kmutex_mutex(mutex));
+        klisp_lock(K);
+
+        if (res != 0) {
+            klispE_throw_simple_with_irritants(K, "Can't lock mutex",
+                                               1, i2tv(res));
+            return;
+        }
+
+        klisp_assert(!kmutex_is_owned(mutex));
+        kmutex_owner(mutex) = thread;
+        kmutex_count(mutex) = 1;
+    }
+}
+
+/* LOCK: GIL should be acquired exactly once */
+void kmutex_unlock(klisp_State *K, TValue mutex)
+{
+    TValue thread = gc2th(K);
+    if (!kmutex_is_owned(mutex)) {
+        klispE_throw_simple(K, "The mutex isn't locked");
+        return;
+    } else if (tv_equal(thread, kmutex_owner(mutex))) {
+        if (kmutex_count(mutex) == 1) {
+            int res = pthread_mutex_unlock(&kmutex_mutex(mutex));
+
+            if (res != 0) {
+                klispE_throw_simple_with_irritants(K, "Can't unlock mutex",
+                                                   1, i2tv(res));
+                return;
+            }
+
+            kmutex_owner(mutex) = KMUTEX_NO_OWNER;
+            kmutex_count(mutex) = 0;
+        } else {
+            --kmutex_count(mutex);
+        }
+    } else {
+        klispE_throw_simple(K, "The mutex is locked by a different thread");
+        return;
+    }
+}
+
+/* LOCK: GIL should be acquired exactly once */
+bool kmutex_trylock(klisp_State *K, TValue mutex)
+{
+    TValue thread = gc2th(K);
+    if (tv_equal(thread, kmutex_owner(mutex))) {
+        kmutex_lock(K, mutex); /* this will check max_count */
+        return true;
+    } else if (kmutex_is_owned(mutex)) {
+        return false;
+    } else {
+        /* we need to release GIL to avoid deadlocks */
+        klisp_unlock(K);
+        int res = pthread_mutex_trylock(&kmutex_mutex(mutex));
+        klisp_lock(K);
+
+        if (res == 0) {
+            klisp_assert(!kmutex_is_owned(mutex));
+            kmutex_owner(mutex) = thread;
+            kmutex_count(mutex) = 1;
+            return true;
+        } else if (res == EBUSY) {
+            return false;
+        } else {
+            klispE_throw_simple_with_irritants(K, "Error on trylock mutex",
+                                               1, i2tv(res));
+            return false;
+        }
+    } 
+}
+
 void klispX_free(klisp_State *K, Mutex *m)
 {
 /* XXX/??? Is it okay if the mutex wasn't correctly created?, 
diff --git a/src/kmutex.h b/src/kmutex.h
@@ -13,12 +13,19 @@
 TValue kmake_mutex(klisp_State *K);
 void klispX_free(klisp_State *K, Mutex *mutex);
 
-/* XXX The functions for locking and unlocking are in kgthreads, for now, 
-   mainly because they use locking... */
+/* LOCK: these functions require that the calling code has 
+   acquired the GIL exactly once previous to the call and
+   they may temporarily release it to avoid deadlocks */
+void kmutex_lock(klisp_State *K, TValue mutex);
+void kmutex_unlock(klisp_State *K, TValue mutex);
+bool kmutex_trylock(klisp_State *K, TValue mutex);
 
-#define kmutex_is_owned(m_) (ttisthread(tv2mutex(p_)->owner))
-#define kmutex_get_owner(m_) (tv2mutex(p_)->owner)
-#define kmutex_get_mutex(m_) (tv2mutex(p_)->mutex)
-#define kmutex_get_count(m_) (tv2mutex(p_)->count)
+#define kmutex_is_owned(m_) (ttisthread(tv2mutex(m_)->owner))
+#define kmutex_owner(m_) (tv2mutex(m_)->owner)
+#define kmutex_mutex(m_) (tv2mutex(m_)->mutex)
+#define kmutex_count(m_) (tv2mutex(m_)->count)
+
+// #define KMUTEX_MAX_COUNT UINT32_MAX
+#define KMUTEX_MAX_COUNT 255
 
 #endif