/* -*- 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 <errno.h>
#include <ecl/ecl.h>
#include <pthread.h>
#include <ecl/internal.h>

/*----------------------------------------------------------------------
 * 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 */
