On Thu, 9 Feb 2012 05:43:10 -0500
Matthew Mondor <mm_li...@pulsar-zone.net> wrote:
> > I here attach the diff for review, testing and comments.
>
> Revised diff attached, the error reporting was done with arguments
> reversed, and there was a redundant pthread.h include.
Well, here again another revision, as I wasn't satisfied with the
verbosity of locking errors.
--
Matt
diff --git a/src/c/threads/mutex.d b/src/c/threads/mutex.d
index c1c9f1e..f04ffcc 100644
--- a/src/c/threads/mutex.d
+++ b/src/c/threads/mutex.d
@@ -4,6 +4,7 @@
*/
/*
Copyright (c) 2003, Juan Jose Garcia Ripoll.
+ Copyright (c) 2012, Matthew Mondor.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
@@ -29,82 +30,245 @@
* LOCKS or MUTEX
*/
+
static void
FEerror_not_a_lock(cl_object lock)
{
+
FEwrong_type_argument(@'mp::lock', lock);
}
+cl_object
+mp_recursive_lock_p(cl_object lock)
+{
+ cl_env_ptr env = ecl_process_env();
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ ecl_return1(env, lock->lock.recursive? Ct : Cnil);
+}
+
+cl_object
+mp_lock_name(cl_object lock)
+{
+ cl_env_ptr env = ecl_process_env();
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ ecl_return1(env, lock->lock.name);
+}
+
+
+/*
+ * New POSIX implementation. To debug race conditions, let's leave no chances
+ * in the implementation to cause any. Let's use the POSIX implementation as
+ * directly as possible, and deprecate the race-prone counter/owner API.
+ */
+#ifndef ECL_WINDOWS_THREADS
+
+
+static int initialized = 0;
+
+static pthread_mutexattr_t mutexattr_normal;
+static pthread_mutexattr_t mutexattr_recursive;
+
+
static void
-FEerror_not_a_recursive_lock(cl_object lock)
+lock_init(void)
{
- FEerror("Attempted to recursively lock ~S which is already owned by
~S",
- 2, lock, lock->lock.holder);
+
+ pthread_mutexattr_init(&mutexattr_normal);
+ pthread_mutexattr_settype(&mutexattr_normal,
+ PTHREAD_MUTEX_ERRORCHECK);
+
+ pthread_mutexattr_init(&mutexattr_recursive);
+ pthread_mutexattr_settype(&mutexattr_recursive,
+ PTHREAD_MUTEX_RECURSIVE);
+
+ initialized = 1;
}
+
static void
-FEerror_not_owned(cl_object lock)
+FEunknown_lock_error(cl_object lock, cl_object op, cl_object error)
{
- FEerror("Attempted to give up lock ~S that is not owned by process ~S",
- 2, lock, mp_current_process());
+
+ FEerror("Error ~A occurred for operation ~A on lock ~A", 3,
+ error, op, lock);
}
static void
-FEunknown_lock_error(cl_object lock)
+FEerror_deprecated_lock_api(cl_object function, cl_object lock)
{
-#ifdef ECL_WINDOWS_THREADS
- FEwin32_error("When acting on lock ~A, got an unexpected error.", 1,
lock);
-#else
- FEerror("When acting on lock ~A, got an unexpected error.", 1, lock);
-#endif
+
+ FEerror("Called deprecated function ~A on lock ~A.",
+ 2, function, lock);
}
+
cl_object
ecl_make_lock(cl_object name, bool recursive)
{
cl_env_ptr the_env = ecl_process_env();
cl_object output = ecl_alloc_object(t_lock);
ecl_disable_interrupts_env(the_env);
+
+ if (!initialized)
+ lock_init();
+
+ pthread_mutex_init(&output->lock.mutex,
+ (recursive ? &mutexattr_recursive : &mutexattr_normal));
output->lock.name = name;
-#ifdef ECL_WINDOWS_THREADS
- output->lock.mutex = CreateMutex(NULL, FALSE, NULL);
-#else
- {
- pthread_mutexattr_t mutexattr_recursive[1];
- pthread_mutexattr_init(mutexattr_recursive);
- pthread_mutexattr_settype(mutexattr_recursive, PTHREAD_MUTEX_RECURSIVE);
- pthread_mutex_init(&output->lock.mutex, mutexattr_recursive);
- }
-#endif
output->lock.holder = Cnil;
output->lock.counter = 0;
output->lock.recursive = recursive;
+
ecl_set_finalizer_unprotected(output, Ct);
ecl_enable_interrupts_env(the_env);
return output;
}
-@(defun mp::make-lock (&key name ((:recursive recursive) Ct))
-@
- @(return ecl_make_lock(name, !Null(recursive)))
-@)
cl_object
-mp_recursive_lock_p(cl_object lock)
+mp_lock_holder(cl_object lock)
{
- cl_env_ptr env = ecl_process_env();
+
if (type_of(lock) != t_lock)
FEerror_not_a_lock(lock);
- ecl_return1(env, lock->lock.recursive? Ct : Cnil);
+ FEerror_deprecated_lock_api(
+ ecl_cstring_to_base_string_or_nil("MP:LOCK-HOLDER"),
+ lock);
}
cl_object
-mp_lock_name(cl_object lock)
+mp_lock_mine_p(cl_object lock)
+{
+
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ FEerror_deprecated_lock_api(
+ ecl_cstring_to_base_string_or_nil("MP:LOCK-MINE-P"),
+ lock);
+}
+
+cl_object
+mp_lock_count(cl_object lock)
+{
+
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ FEerror_deprecated_lock_api(
+ ecl_cstring_to_base_string_or_nil("MP:LOCK-COUNT"),
+ lock);
+}
+
+cl_object
+mp_lock_count_mine(cl_object lock)
{
+
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ FEerror_deprecated_lock_api(
+ ecl_cstring_to_base_string_or_nil("MP:LOCK-COUNT-MINE"),
+ lock);
+}
+
+
+/* Now let's deal as directly as possible with mutexes. */
+
+cl_object
+mp_giveup_lock(cl_object lock)
+{
+ int rc;
cl_env_ptr env = ecl_process_env();
+
if (type_of(lock) != t_lock)
FEerror_not_a_lock(lock);
- ecl_return1(env, lock->lock.name);
+ if ((rc = pthread_mutex_unlock(&lock->lock.mutex)) != 0)
+ FEunknown_lock_error(lock,
+ ecl_cstring_to_base_string_or_nil("GIVEUP-LOCK"),
+ ecl_make_int(rc));
+
+ ecl_return1(env, Ct);
+}
+
+cl_object
+mp_get_lock_nowait(cl_object lock)
+{
+ int rc;
+ cl_env_ptr env = ecl_process_env();
+
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ if ((rc = pthread_mutex_trylock(&lock->lock.mutex)) != 0)
+ FEunknown_lock_error(lock,
+ ecl_cstring_to_base_string_or_nil("GET-LOCK-NOWAIT"),
+ ecl_make_int(rc));
+
+ ecl_return1(env, lock);
+}
+
+cl_object
+mp_get_lock_wait(cl_object lock)
+{
+ int rc;
+ cl_env_ptr env = ecl_process_env();
+
+ if (type_of(lock) != t_lock)
+ FEerror_not_a_lock(lock);
+ if ((rc = pthread_mutex_lock(&lock->lock.mutex)) != 0)
+ FEunknown_lock_error(lock,
+ ecl_cstring_to_base_string_or_nil("GET-LOCK-WAIT"),
+ ecl_make_int(rc));
+
+ ecl_return1(env, lock);
+}
+
+
+#endif /* !ECL_WINDOWS_THREADS */
+
+
+/*
+ * Old Windows implementation left as-is for now, but isolated separately.
+ */
+#ifdef ECL_WINDOWS_THREADS
+
+
+static void
+FEerror_not_a_recursive_lock(cl_object lock)
+{
+ FEerror("Attempted to recursively lock ~S which is already owned by
~S",
+ 2, lock, lock->lock.holder);
+}
+
+static void
+FEerror_not_owned(cl_object lock)
+{
+ FEerror("Attempted to give up lock ~S that is not owned by process ~S",
+ 2, lock, mp_current_process());
+}
+
+static void
+FEunknown_lock_error(cl_object lock)
+{
+ FEwin32_error("When acting on lock ~A, got an unexpected error.",
+ 1, lock);
+}
+
+cl_object
+ecl_make_lock(cl_object name, bool recursive)
+{
+ cl_env_ptr the_env = ecl_process_env();
+ cl_object output = ecl_alloc_object(t_lock);
+
+ ecl_disable_interrupts_env(the_env);
+ output->lock.name = name;
+ output->lock.mutex = CreateMutex(NULL, FALSE, NULL);
+ output->lock.holder = Cnil;
+ output->lock.counter = 0;
+ output->lock.recursive = recursive;
+ ecl_set_finalizer_unprotected(output, Ct);
+ ecl_enable_interrupts_env(the_env);
+
+ return output;
}
cl_object
@@ -158,12 +322,8 @@ mp_giveup_lock(cl_object lock)
FEerror_not_owned(lock);
if (--lock->lock.counter == 0) {
lock->lock.holder = Cnil;
-#ifdef ECL_WINDOWS_THREADS
if (ReleaseMutex(lock->lock.mutex) == 0)
FEunknown_lock_error(lock);
-#else
- pthread_mutex_unlock(&lock->lock.mutex);
-#endif
}
ecl_return1(env, Ct);
}
@@ -186,7 +346,6 @@ mp_get_lock_nowait(cl_object lock)
* interrupts. If an interupt happens right after we locked the mutex
* but before we set count and owner, we are in trouble, since the
* mutex might be locked. */
-#ifdef ECL_WINDOWS_THREADS
switch (WaitForSingleObject(lock->lock.mutex, 0)) {
case WAIT_OBJECT_0:
lock->lock.counter++;
@@ -199,18 +358,6 @@ mp_get_lock_nowait(cl_object lock)
FEunknown_lock_error(lock);
ecl_return1(env, Cnil);
}
-#else
- rc = pthread_mutex_trylock(&lock->lock.mutex);
- if (rc == 0) {
- lock->lock.counter++;
- lock->lock.holder = own_process;
- ecl_return1(env, lock);
- } else {
- if (rc != EBUSY)
- FEunknown_lock_error(lock);
- ecl_return1(env, Cnil);
- }
-#endif
}
cl_object
@@ -231,7 +378,6 @@ mp_get_lock_wait(cl_object lock)
* interrupts. If an interupt happens right after we locked the mutex
* but before we set count and owner, we are in trouble, since the
* mutex might be locked. */
-#ifdef ECL_WINDOWS_THREADS
switch (WaitForSingleObject(lock->lock.mutex, INFINITE)) {
case WAIT_OBJECT_0:
lock->lock.counter++;
@@ -244,19 +390,17 @@ mp_get_lock_wait(cl_object lock)
FEunknown_lock_error(lock);
ecl_return1(env, Cnil);
}
-#else
- rc = pthread_mutex_lock(&lock->lock.mutex);
- if (rc == 0) {
- lock->lock.counter++;
- lock->lock.holder = own_process;
- ecl_return1(env, lock);
- } else {
- FEunknown_lock_error(lock);
- ecl_return1(env, Cnil);
- }
-#endif
}
+
+#endif /* ECL_WINDOWS_THREADS */
+
+
+@(defun mp::make-lock (&key name ((:recursive recursive) Ct))
+@
+ @(return ecl_make_lock(name, !Null(recursive)))
+@)
+
@(defun mp::get-lock (lock &optional (wait Ct))
@
if (Null(wait))
@@ -264,3 +408,4 @@ mp_get_lock_wait(cl_object lock)
else
return mp_get_lock_wait(lock);
@)
+
diff --git a/src/lsp/mp.lsp b/src/lsp/mp.lsp
index ce0a9c5..38ca207 100644
--- a/src/lsp/mp.lsp
+++ b/src/lsp/mp.lsp
@@ -107,23 +107,33 @@ by ALLOW-WITH-INTERRUPTS."
(defmacro with-lock ((lock-form &rest options) &body body)
#-threads
`(progn ,@body)
- ;; Why do we need %count? Even if get-lock succeeeds, an interrupt may
- ;; happen between the end of get-lock and when we save the output of
- ;; the function. That means we lose the information and ignore that
- ;; the lock was actually acquired. Furthermore, a lock can be recursive
- ;; and mp:lock-holder is also not reliable.
- ;;
- ;; Next notice how we need to disable interrupts around the body and
- ;; the get-lock statement, to ensure that the unlocking is done with
- ;; interrupts disabled.
#+threads
- (ext:with-unique-names (lock count)
- `(let* ((,lock ,lock-form)
- (,count (mp:lock-count-mine ,lock)))
+ #-windows
+ (ext:with-unique-names (lock)
+ `(let* ((,lock ,lock-form))
(without-interrupts
(unwind-protect
(with-restored-interrupts
(mp::get-lock ,lock)
(locally ,@body))
- (when (> (mp:lock-count-mine ,lock) ,count)
- (mp::giveup-lock ,lock)))))))
+ (mp::giveup-lock ,lock)))))
+ #+windows
+ (ext:with-unique-names (lock count)
+ ;; Why do we need %count? Even if get-lock succeeeds, an interrupt may
+ ;; happen between the end of get-lock and when we save the output of
+ ;; the function. That means we lose the information and ignore that
+ ;; the lock was actually acquired. Furthermore, a lock can be recursive
+ ;; and mp:lock-holder is also not reliable.
+ ;;
+ ;; Next notice how we need to disable interrupts around the body and
+ ;; the get-lock statement, to ensure that the unlocking is done with
+ ;; interrupts disabled.
+ `(let* ((,lock ,lock-form)
+ (,count (mp:lock-count-mine ,lock)))
+ (without-interrupts
+ (unwind-protect
+ (with-restored-interrupts
+ (mp::get-lock ,lock)
+ (locally ,@body))
+ (when (> (mp:lock-count-mine ,lock) ,count)
+ (mp::giveup-lock ,lock)))))))
------------------------------------------------------------------------------
Virtualization & Cloud Management Using Capacity Planning
Cloud computing makes use of virtualization - but cloud computing
also focuses on allowing computing to be delivered as a service.
http://www.accelacomm.com/jaw/sfnl/114/51521223/
_______________________________________________
Ecls-list mailing list
Ecls-list@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/ecls-list
