mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-15 15:21:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

Split the threads code into separate files.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-10-23 21:43:46 +02:00
parent e27974cf76
commit 3dfb2d6dcb
8 changed files with 425 additions and 355 deletions
Download patch file Download diff file Expand all files Collapse all files

2
msvc/c/Makefile
View file

@ -14,7 +14,7 @@ ECL_FPE_CODE=fpe_x86.c
!if "$(ECL_THREADS)" != ""
ECL_THREADS_FLAG=1
THREADS_OBJ= threads.obj threads_mutex.obj
THREADS_OBJ= threads/process.obj threads/mutex.obj threads/condition_variable.obj
!else
ECL_THREADS_FLAG=0
THREADS_OBJ=

0
msvc/c/threads/placeholder Normal file
View file

3
src/aclocal.m4 vendored
View file

@ -232,7 +232,7 @@ THREAD_CFLAGS=''
THREAD_LIBS=''
THREAD_GC_FLAGS='--enable-threads=posix'
INSTALL_TARGET='install'
THREAD_OBJ='threads threads_mutex'
THREAD_OBJ='threads/process threads/mutex threads/condition_variable'
clibs=''
SONAME=''
SONAME_LDFLAGS=''
@ -823,6 +823,7 @@ AC_MSG_RESULT([$ECL_WORKING_SEM_INIT])
if test $ECL_WORKING_SEM_INIT = yes ; then
AC_DEFINE(ECL_SEMAPHORES)
AC_DEFINE(HAVE_SEM_INIT)
THREAD_OBJ="$THREAD_OBJ threads/semaphore"
fi
])

189
src/c/threads/condition_variable.d Normal file
View file

@ -0,0 +1,189 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
condition_variable.d -- Native threads.
*/
/*
Copyright (c) 2003, Juan Jose Garcia Ripoll.
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 __sun__ /* See unixinit.d for this */
#define _XOPEN_SOURCE 600 /* For pthread mutex attributes */
#endif
#include <errno.h>
#include <time.h>
#include <signal.h>
#define ECL_INCLUDE_MATH_H
#include <ecl/ecl.h>
#ifdef ECL_WINDOWS_THREADS
# include <windows.h>
#else
# include <pthread.h>
#endif
#ifdef HAVE_GETTIMEOFDAY
# include <sys/time.h>
#endif
#ifdef HAVE_SCHED_YIELD
# include <sched.h>
#endif
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>
/*----------------------------------------------------------------------
* CONDITION VARIABLES
*/
cl_object
mp_make_condition_variable(void)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
@(return Cnil)
#else
cl_object output;
output = ecl_alloc_object(t_condition_variable);
pthread_cond_init(&output->condition_variable.cv, NULL);
si_set_finalizer(output, Ct);
@(return output)
#endif
}
cl_object
mp_condition_variable_wait(cl_object cv, cl_object lock)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
int count, rc;
cl_object own_process = mp_current_process();
if (ecl_unlikely(type_of(cv) != t_condition_variable))
FEwrong_type_nth_arg(@[mp::condition-variable-wait], 1, cv,
@[mp::condition-variable]);
if (ecl_unlikely(type_of(lock) != t_lock))
FEwrong_type_nth_arg(@[mp::condition-variable-wait], 2, lock,
@[mp::lock]);
if (ecl_unlikely(lock->lock.holder != own_process)) {
FEerror("Attempt to wait on a condition variable using lock~%~S"
"~%which is not owned by process~%~S", 2, lock, own_process);
}
if (ecl_unlikely(lock->lock.counter > 1)) {
FEerror("mp:condition-variable-wait can not be used with recursive"
" locks:~%~S", 1, lock);
}
/* Note: this is highly unsafe. We are marking the lock as released
* without knowing whether pthread_cond_wait worked as expected. */
lock->lock.counter = 0;
lock->lock.holder = Cnil;
rc = pthread_cond_wait(&cv->condition_variable.cv,
&lock->lock.mutex);
lock->lock.holder = own_process;
lock->lock.counter = 1;
if (ecl_unlikely(rc != 0)) {
FEerror("System returned error code ~D "
"when waiting on condition variable~%~A~%and lock~%~A.",
3, MAKE_FIXNUM(rc), cv, lock);
}
#endif
@(return Ct)
}
cl_object
mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
int rc;
cl_object own_process = mp_current_process();
double r;
struct timespec ts;
struct timeval tp;
if (ecl_unlikely(type_of(cv) != t_condition_variable))
FEwrong_type_nth_arg(@[mp::condition-variable-timedwait],
1, cv, @[mp::condition-variable]);
if (ecl_unlikely(type_of(lock) != t_lock))
FEwrong_type_nth_arg(@[mp::condition-variable-timedwait],
2, lock, @[mp::lock]);
if (ecl_unlikely(lock->lock.holder != own_process)) {
FEerror("Attempt to wait on a condition variable using lock~%~S"
"~%which is not owned by process~%~S", 2, lock, own_process);
}
if (ecl_unlikely(lock->lock.counter > 1)) {
FEerror("mp:condition-variable-wait can not be used with recursive"
" locks:~%~S", 1, lock);
}
/* INV: ecl_minusp() makes sure `seconds' is real */
if (ecl_unlikely(ecl_minusp(seconds))) {
cl_error(9, @'simple-type-error', @':format-control',
make_constant_base_string("Not a non-negative number ~S"),
@':format-arguments', cl_list(1, seconds),
@':expected-type', @'real', @':datum', seconds);
}
gettimeofday(&tp, NULL);
/* Convert from timeval to timespec */
ts.tv_sec = tp.tv_sec;
ts.tv_nsec = tp.tv_usec * 1000;
/* Add `seconds' delta */
r = ecl_to_double(seconds);
ts.tv_sec += (time_t)floor(r);
ts.tv_nsec += (long)((r - floor(r)) * 1e9);
if (ts.tv_nsec >= 1e9) {
ts.tv_nsec -= 1e9;
ts.tv_sec++;
}
/* Note: this is highly unsafe. We are marking the lock as released
* without knowing whether pthread_cond_wait worked as expected. */
lock->lock.counter = 0;
lock->lock.holder = Cnil;
rc = pthread_cond_timedwait(&cv->condition_variable.cv,
&lock->lock.mutex, &ts);
lock->lock.holder = own_process;
lock->lock.counter = 1;
if (rc != 0 && rc != ETIMEDOUT) {
FEerror("System returned error code ~D "
"when waiting on condition variable~%~A~%and lock~%~A.",
3, MAKE_FIXNUM(rc), cv, lock);
}
@(return (rc? Ct : Cnil))
#endif
}
cl_object
mp_condition_variable_signal(cl_object cv)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
if (ecl_unlikely(type_of(cv) != t_condition_variable)) {
FEwrong_type_only_arg(@[mp::condition-variable-signal],
cv, @[mp::condition-variable]);
}
pthread_cond_signal(&cv->condition_variable.cv);
#endif
@(return Ct)
}
cl_object
mp_condition_variable_broadcast(cl_object cv)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
if (ecl_unlikely(type_of(cv) != t_condition_variable)) {
FEwrong_type_only_arg(@[mp::condition-variable-broadcast],
cv, @[mp::condition-variable]);
}
pthread_cond_broadcast(&cv->condition_variable.cv);
#endif
@(return Ct)
}

0
src/c/threads_mutex.d → src/c/threads/mutex.d
View file

352
src/c/threads.d → src/c/threads/process.d
View file

@ -32,9 +32,6 @@
#ifdef HAVE_SCHED_YIELD
# include <sched.h>
#endif
#ifdef HAVE_SEMAPHORE_H
# include <semaphore.h>
#endif
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>
@ -608,355 +605,6 @@ mp_restore_signals(cl_object sigmask)
#endif
}
/*----------------------------------------------------------------------
* CONDITION VARIABLES
*/
cl_object
mp_make_condition_variable(void)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
@(return Cnil)
#else
cl_object output;
output = ecl_alloc_object(t_condition_variable);
pthread_cond_init(&output->condition_variable.cv, NULL);
si_set_finalizer(output, Ct);
@(return output)
#endif
}
cl_object
mp_condition_variable_wait(cl_object cv, cl_object lock)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
int count, rc;
cl_object own_process = mp_current_process();
if (ecl_unlikely(type_of(cv) != t_condition_variable))
FEwrong_type_nth_arg(@[mp::condition-variable-wait], 1, cv,
@[mp::condition-variable]);
if (ecl_unlikely(type_of(lock) != t_lock))
FEwrong_type_nth_arg(@[mp::condition-variable-wait], 2, lock,
@[mp::lock]);
if (ecl_unlikely(lock->lock.holder != own_process)) {
FEerror("Attempt to wait on a condition variable using lock~%~S"
"~%which is not owned by process~%~S", 2, lock, own_process);
}
if (ecl_unlikely(lock->lock.counter > 1)) {
FEerror("mp:condition-variable-wait can not be used with recursive"
" locks:~%~S", 1, lock);
}
/* Note: this is highly unsafe. We are marking the lock as released
* without knowing whether pthread_cond_wait worked as expected. */
lock->lock.counter = 0;
lock->lock.holder = Cnil;
rc = pthread_cond_wait(&cv->condition_variable.cv,
&lock->lock.mutex);
lock->lock.holder = own_process;
lock->lock.counter = 1;
if (ecl_unlikely(rc != 0)) {
FEerror("System returned error code ~D "
"when waiting on condition variable~%~A~%and lock~%~A.",
3, MAKE_FIXNUM(rc), cv, lock);
}
#endif
@(return Ct)
}
cl_object
mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
int rc;
cl_object own_process = mp_current_process();
double r;
struct timespec ts;
struct timeval tp;
if (ecl_unlikely(type_of(cv) != t_condition_variable))
FEwrong_type_nth_arg(@[mp::condition-variable-timedwait],
1, cv, @[mp::condition-variable]);
if (ecl_unlikely(type_of(lock) != t_lock))
FEwrong_type_nth_arg(@[mp::condition-variable-timedwait],
2, lock, @[mp::lock]);
if (ecl_unlikely(lock->lock.holder != own_process)) {
FEerror("Attempt to wait on a condition variable using lock~%~S"
"~%which is not owned by process~%~S", 2, lock, own_process);
}
if (ecl_unlikely(lock->lock.counter > 1)) {
FEerror("mp:condition-variable-wait can not be used with recursive"
" locks:~%~S", 1, lock);
}
/* INV: ecl_minusp() makes sure `seconds' is real */
if (ecl_unlikely(ecl_minusp(seconds))) {
cl_error(9, @'simple-type-error', @':format-control',
make_constant_base_string("Not a non-negative number ~S"),
@':format-arguments', cl_list(1, seconds),
@':expected-type', @'real', @':datum', seconds);
}
gettimeofday(&tp, NULL);
/* Convert from timeval to timespec */
ts.tv_sec = tp.tv_sec;
ts.tv_nsec = tp.tv_usec * 1000;
/* Add `seconds' delta */
r = ecl_to_double(seconds);
ts.tv_sec += (time_t)floor(r);
ts.tv_nsec += (long)((r - floor(r)) * 1e9);
if (ts.tv_nsec >= 1e9) {
ts.tv_nsec -= 1e9;
ts.tv_sec++;
}
/* Note: this is highly unsafe. We are marking the lock as released
* without knowing whether pthread_cond_wait worked as expected. */
lock->lock.counter = 0;
lock->lock.holder = Cnil;
rc = pthread_cond_timedwait(&cv->condition_variable.cv,
&lock->lock.mutex, &ts);
lock->lock.holder = own_process;
lock->lock.counter = 1;
if (rc != 0 && rc != ETIMEDOUT) {
FEerror("System returned error code ~D "
"when waiting on condition variable~%~A~%and lock~%~A.",
3, MAKE_FIXNUM(rc), cv, lock);
}
@(return (rc? Ct : Cnil))
#endif
}
cl_object
mp_condition_variable_signal(cl_object cv)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
if (ecl_unlikely(type_of(cv) != t_condition_variable)) {
FEwrong_type_only_arg(@[mp::condition-variable-signal],
cv, @[mp::condition-variable]);
}
pthread_cond_signal(&cv->condition_variable.cv);
#endif
@(return Ct)
}
cl_object
mp_condition_variable_broadcast(cl_object cv)
{
#ifdef ECL_WINDOWS_THREADS
FEerror("Condition variables are not supported under Windows.", 0);
#else
if (ecl_unlikely(type_of(cv) != t_condition_variable)) {
FEwrong_type_only_arg(@[mp::condition-variable-broadcast],
cv, @[mp::condition-variable]);
}
pthread_cond_broadcast(&cv->condition_variable.cv);
#endif
@(return Ct)
}
/*----------------------------------------------------------------------
* SEMAPHORES
*/
#ifdef ECL_SEMAPHORES
# ifdef ECL_MACH_SEMAPHORES
struct ecl_semaphore_inner {
task_t owner;
semaphore_t counter[1];
};
# endif
@(defun mp::make-semaphore (max &key name ((:count count) MAKE_FIXNUM(0)))
cl_object output;
cl_index initial_count, max_count;
@
{
output = ecl_alloc_object(t_semaphore);
ecl_disable_interrupts_env(the_env);
output->semaphore.name = name;
output->semaphore.handle = NULL;
ecl_set_finalizer_unprotected(output, Ct);
if (ecl_unlikely(!ECL_FIXNUMP(max) ||
ecl_fixnum_minusp(max) ||
ecl_fixnum_greaterp(max, MAKE_FIXNUM(0xFFFF)))) {
FEwrong_type_nth_arg(@[mp::make-semaphore], 1, max,
ecl_make_integer_type(MAKE_FIXNUM(0),
MAKE_FIXNUM(0xFFFF)));
}
max_count = fix(max);
if (ecl_unlikely(!ECL_FIXNUMP(count) ||
((initial_count = fix(count)) < 0) ||
initial_count > max_count)) {
FEwrong_type_key_arg(@[mp::make-semaphore], @[:count], count,
ecl_make_integer_type(MAKE_FIXNUM(0),
max));
}
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = CreateSemaphore(NULL,
initial_count,
0xFFFF,
NULL);
output->semaphore.handle = h;
ecl_enable_interrupts_env(the_env);
if (h == NULL)
FEwin32_error("Unable to create semaphore object.", 0);
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = ecl_alloc_atomic(sizeof(sem_t));
int rc = sem_init(h, 0, initial_count);
if (!rc)
output->semaphore.handle = h;
ecl_enable_interrupts();
if (rc)
FEerror("Unable to create semaphore object.", 0);
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return output)
}
@)
cl_object
mp_semaphore_trywait(cl_object sem)
{
cl_object output;
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-trywait], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
switch (WaitForSingleObject(h, 0)) {
case WAIT_OBJECT_0:
output = Ct;
break;
case WAIT_TIMEOUT:
output = Cnil;
break;
default:
FEwin32_error("Unable to wait on semaphore", 0);
output = Cnil;
}
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = (sem_t *)(sem->semaphore.handle);
int rc = sem_trywait(h);
if (sem_trywait(h)) {
if (errno != EAGAIN) {
FElibc_error("Unable to wait on semaphore", 0);
}
output = Cnil;
} else {
output = Ct;
}
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return output)
}
cl_object
mp_semaphore_wait(cl_object sem)
{
cl_object output;
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-wait], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
if (WaitForSingleObject(h, INFINITE) != WAIT_OBJECT_0) {
FEwin32_error("Unable to wait on semaphore", 0);
}
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = (sem_t *)(sem->semaphore.handle);
int rc = sem_wait(h);
if (sem_wait(h)) {
if (errno == EINTR) {
ecl_check_pending_interrupts();
goto AGAIN;
}
FElibc_error("Unable to wait on semaphore", 0);
}
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return Ct)
}
cl_object
mp_semaphore_signal(cl_object sem)
{
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-signal], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
if (!ReleaseSemaphore(h, 1, NULL)) {
FEwin32_error("Unable to post on semaphore ~A" 1, sem);
}
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = (sem_t *)(sem->semaphore.handle);
int rc = sem_wait(h);
if (sem_wait(h)) {
if (errno == EINTR) {
ecl_check_pending_interrupts();
goto AGAIN;
}
FElibc_error("Unable to post on semaphore ~A", 1, sem);
}
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return Ct)
}
cl_object
mp_semaphore_close(cl_object sem)
{
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-close], sem, @[mp::semaphore]);
}
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
if (h) CloseHandle(h);
}
#else
# ifdef HAVE_SEM_INIT
/*
* No need for closing.
*/
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return Ct)
}
#endif /* ECL_SEMAPHORES */
/*----------------------------------------------------------------------
* INITIALIZATION
*/

231
src/c/threads/semaphore.d Normal file
View file

@ -0,0 +1,231 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
semaphores.d -- POSIX semaphores
*/
/*
Copyright (c) 2003, Juan Jose Garcia Ripoll.
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 __sun__ /* See unixinit.d for this */
#define _XOPEN_SOURCE 600 /* For pthread mutex attributes */
#endif
#include <errno.h>
#include <time.h>
#include <signal.h>
#define ECL_INCLUDE_MATH_H
#include <ecl/ecl.h>
#ifdef ECL_WINDOWS_THREADS
# include <windows.h>
#else
# include <pthread.h>
#endif
#ifdef HAVE_GETTIMEOFDAY
# include <sys/time.h>
#endif
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>
/*----------------------------------------------------------------------
* SEMAPHORES
*/
#ifdef ECL_SEMAPHORES
# ifdef ECL_MACH_SEMAPHORES
struct ecl_semaphore_inner {
task_t owner;
semaphore_t counter[1];
};
# endif
@(defun mp::make-semaphore (max &key name ((:count count) MAKE_FIXNUM(0)))
cl_object output;
cl_index initial_count, max_count;
@
{
output = ecl_alloc_object(t_semaphore);
ecl_disable_interrupts_env(the_env);
output->semaphore.name = name;
output->semaphore.handle = NULL;
ecl_set_finalizer_unprotected(output, Ct);
if (ecl_unlikely(!ECL_FIXNUMP(max) ||
ecl_fixnum_minusp(max) ||
ecl_fixnum_greaterp(max, MAKE_FIXNUM(0xFFFF)))) {
FEwrong_type_nth_arg(@[mp::make-semaphore], 1, max,
ecl_make_integer_type(MAKE_FIXNUM(0),
MAKE_FIXNUM(0xFFFF)));
}
max_count = fix(max);
if (ecl_unlikely(!ECL_FIXNUMP(count) ||
((initial_count = fix(count)) < 0) ||
initial_count > max_count)) {
FEwrong_type_key_arg(@[mp::make-semaphore], @[:count], count,
ecl_make_integer_type(MAKE_FIXNUM(0),
max));
}
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = CreateSemaphore(NULL,
initial_count,
0xFFFF,
NULL);
output->semaphore.handle = h;
ecl_enable_interrupts_env(the_env);
if (h == NULL)
FEwin32_error("Unable to create semaphore object.", 0);
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = ecl_alloc_atomic(sizeof(sem_t));
int rc = sem_init(h, 0, initial_count);
if (!rc)
output->semaphore.handle = h;
ecl_enable_interrupts();
if (rc)
FEerror("Unable to create semaphore object.", 0);
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return output)
}
@)
cl_object
mp_semaphore_trywait(cl_object sem)
{
cl_object output;
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-trywait], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
switch (WaitForSingleObject(h, 0)) {
case WAIT_OBJECT_0:
output = Ct;
break;
case WAIT_TIMEOUT:
output = Cnil;
break;
default:
FEwin32_error("Unable to wait on semaphore", 0);
output = Cnil;
}
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = (sem_t *)(sem->semaphore.handle);
int rc = sem_trywait(h);
if (sem_trywait(h)) {
if (errno != EAGAIN) {
FElibc_error("Unable to wait on semaphore", 0);
}
output = Cnil;
} else {
output = Ct;
}
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return output)
}
cl_object
mp_semaphore_wait(cl_object sem)
{
cl_object output;
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-wait], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
if (WaitForSingleObject(h, INFINITE) != WAIT_OBJECT_0) {
FEwin32_error("Unable to wait on semaphore", 0);
}
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = (sem_t *)(sem->semaphore.handle);
int rc = sem_wait(h);
if (sem_wait(h)) {
if (errno == EINTR) {
ecl_check_pending_interrupts();
goto AGAIN;
}
FElibc_error("Unable to wait on semaphore", 0);
}
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return Ct)
}
cl_object
mp_semaphore_signal(cl_object sem)
{
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-signal], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
if (!ReleaseSemaphore(h, 1, NULL)) {
FEwin32_error("Unable to post on semaphore ~A" 1, sem);
}
}
#else
# ifdef HAVE_SEM_INIT
{
sem_t *h = (sem_t *)(sem->semaphore.handle);
int rc = sem_wait(h);
if (sem_wait(h)) {
if (errno == EINTR) {
ecl_check_pending_interrupts();
goto AGAIN;
}
FElibc_error("Unable to post on semaphore ~A", 1, sem);
}
}
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return Ct)
}
cl_object
mp_semaphore_close(cl_object sem)
{
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@[mp::semaphore-close], sem, @[mp::semaphore]);
}
#ifdef ECL_WINDOWS_THREADS
{
HANDLE h = (HANDLE)(sem->semaphore.handle);
if (h) CloseHandle(h);
}
#else
# ifdef HAVE_SEM_INIT
/*
* No need for closing.
*/
# endif /* HAVE_SEM_INIT */
#endif /* ECL_WINDOWS_THREADS */
@(return Ct)
}
#endif /* ECL_SEMAPHORES */

3
src/configure vendored
View file

@ -4610,7 +4610,7 @@ THREAD_CFLAGS=''
THREAD_LIBS=''
THREAD_GC_FLAGS='--enable-threads=posix'
INSTALL_TARGET='install'
THREAD_OBJ='threads threads_mutex'
THREAD_OBJ='threads/process threads/mutex threads/condition_variable'
clibs=''
SONAME=''
SONAME_LDFLAGS=''
@ -6116,6 +6116,7 @@ _ACEOF
#define HAVE_SEM_INIT 1
_ACEOF
THREAD_OBJ="$THREAD_OBJ threads/semaphore"
fi
fi