/* -*- mode: c; c-basic-offset: 8 -*- */ /* threads_mutex.d -- Native mutually exclusive locks. */ /* Copyright (c) 2003, Juan Jose Garcia Ripoll. Copyright (c) 2011, Matthew Mondor. ECL is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. See file '../Copyright' for full details. */ #ifndef ECL_WINDOWS_THREADS #ifndef __sun__ /* See unixinit.d for this */ #define _XOPEN_SOURCE 600 /* For pthread mutex attributes */ #endif #include #include #include #include /*---------------------------------------------------------------------- * LOCKS or MUTEX */ static int initialized = 0; static pthread_mutexattr_t mutexattr_normal; static pthread_mutexattr_t mutexattr_recursive; static void lock_init(void) { 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_a_lock(cl_object lock) { FEwrong_type_argument(@'mp::lock', lock); } static void FEunknown_lock_error(cl_object lock, cl_object error) { FEerror("Error ~A when operating on lock ~A.", 2, error, lock); } static void FEerror_deprecated_lock_api(cl_object function, cl_object lock) { 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; 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))) @) /* * XXX The following functions are mostly useless except perhaps for * reflection and/or debugging. They unfortunately also add complexity, * raising the chances of race conditions. */ 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); } cl_object mp_lock_holder(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-HOLDER"), lock); } cl_object 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); if ((rc = pthread_mutex_unlock(&lock->lock.mutex)) != 0) FEunknown_lock_error(ecl_make_int(rc), lock); 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(ecl_make_int(rc), lock); 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(ecl_make_int(rc), lock); ecl_return1(env, lock); } @(defun mp::get-lock (lock &optional (wait Ct)) @ if (Null(wait)) return mp_get_lock_nowait(lock); else return mp_get_lock_wait(lock); @) #endif /* ECL_WINDOWS_THREADS */