diff --git a/src/aclocal.m4 b/src/aclocal.m4 index f9daa4955..d771f5d22 100644 --- a/src/aclocal.m4 +++ b/src/aclocal.m4 @@ -248,7 +248,7 @@ THREAD_CFLAGS='' THREAD_LIBS='' THREAD_GC_FLAGS='--enable-threads=posix' INSTALL_TARGET='install' -THREAD_OBJ="$THREAD_OBJ threads/process threads/mutex threads/condition_variable" +THREAD_OBJ="$THREAD_OBJ threads/process threads/queue threads/mutex threads/condition_variable" clibs='' SONAME='' SONAME_LDFLAGS='' diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 3f568456b..366e55bd1 100755 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -439,6 +439,7 @@ cl_object_mark_proc(void *addr, struct GC_ms_entry *msp, struct GC_ms_entry *msl # endif # ifdef ECL_THREADS case t_process: + MAYBE_MARK(o->process.waiting_for); MAYBE_MARK(o->process.exit_values); MAYBE_MARK(o->process.exit_lock); MAYBE_MARK(o->process.parent); @@ -972,7 +973,8 @@ init_alloc(void) to_bitmap(&o, &(o.process.initial_bindings)) | to_bitmap(&o, &(o.process.parent)) | to_bitmap(&o, &(o.process.exit_lock)) | - to_bitmap(&o, &(o.process.exit_values)); + to_bitmap(&o, &(o.process.exit_values)) | + to_bitmap(&o, &(o.process.waiting_for))); type_info[t_lock].descriptor = to_bitmap(&o, &(o.lock.name)) | to_bitmap(&o, &(o.lock.owner)); diff --git a/src/c/main.d b/src/c/main.d index a603ca02f..75e3fae02 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -408,9 +408,6 @@ struct cl_core_struct cl_core = { 0, /* path_max */ #ifdef GBC_BOEHM NULL, /* safety_region */ -#endif -#ifdef ECL_THREADS - Cnil, /* signal_queue_lock */ #endif Cnil, /* signal_queue */ diff --git a/src/c/threads/mutex.d b/src/c/threads/mutex.d index fc6f56b5c..281773df4 100644 --- a/src/c/threads/mutex.d +++ b/src/c/threads/mutex.d @@ -1,6 +1,6 @@ /* -*- mode: c; c-basic-offset: 8 -*- */ /* - threads_mutex.d -- Native mutually exclusive locks. + mutex.d -- mutually exclusive locks. */ /* Copyright (c) 2003, Juan Jose Garcia Ripoll. @@ -13,17 +13,8 @@ See file '../Copyright' for full details. */ -#ifndef __sun__ /* See unixinit.d for this */ -#define _XOPEN_SOURCE 600 /* For pthread mutex attributes */ -#endif -#include #define AO_ASSUME_WINDOWS98 /* We need this for CAS */ #include -#ifdef ECL_WINDOWS_THREADS -# include -#else -# include -#endif #include /*---------------------------------------------------------------------- @@ -53,14 +44,12 @@ FEerror_not_owned(cl_object 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.owner = Cnil; output->lock.counter = 0; + output->lock.waiter = Cnil; output->lock.recursive = recursive; - ecl_enable_interrupts_env(the_env); return output; } @@ -123,6 +112,10 @@ mp_giveup_lock(cl_object lock) ecl_disable_interrupts_env(env); if (--lock->lock.counter == 0) { lock->lock.owner = Cnil; + if (lock->lock.waiter != Cnil) { + lock->lock.waiter = Cnil; + ecl_wakeup_waiters(lock, 1); + } } ecl_enable_interrupts_env(env); ecl_return1(env, Ct); @@ -164,28 +157,10 @@ mp_get_lock_nowait(cl_object lock) cl_object mp_get_lock_wait(cl_object lock) { - struct ecl_timeval start; - cl_env_ptr env = ecl_process_env(); - cl_object own_process = env->own_process; - cl_fixnum code, iteration; - unlikely_if (type_of(lock) != t_lock) { - FEerror_not_a_lock(lock); + if (mp_get_lock_nowait(lock) == Cnil) { + ecl_wait_on(mp_get_lock_nowait, lock); } - iteration = 0; - do { - int n; - ecl_disable_interrupts_env(env); - for (n = 0, code = 0; n < 100 && code == 0; n++) - code = get_lock_inner(lock, own_process); - ecl_enable_interrupts_env(env); - unlikely_if (code < 0) - FEerror_not_a_recursive_lock(lock); - if (code > 0) - @(return Ct); - if (!iteration) - ecl_get_internal_real_time(&start); - ecl_wait_for(++iteration, &start); - } while (1); + @(return Ct) } @(defun mp::get-lock (lock &optional (wait Ct)) diff --git a/src/c/threads/queue.d b/src/c/threads/queue.d new file mode 100644 index 000000000..f1d2fca77 --- /dev/null +++ b/src/c/threads/queue.d @@ -0,0 +1,121 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + queue.d -- waiting queue for threads. +*/ +/* + Copyright (c) 2011, 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. +*/ + +#define AO_ASSUME_WINDOWS98 /* We need this for CAS */ +#include +#include + +/*---------------------------------------------------------------------- + * THREAD SCHEDULER & WAITING + */ + +static cl_object +bignum_set_time(cl_object bignum, struct ecl_timeval *time) +{ + _ecl_big_set_index(bignum, time->tv_sec); + _ecl_big_mul_ui(bignum, bignum, 1000); + _ecl_big_add_ui(bignum, bignum, (time->tv_usec + 999) / 1000); + return bignum; +} + +static cl_object +elapsed_time(struct ecl_timeval *start) +{ + cl_object delta_big = _ecl_big_register0(); + cl_object aux_big = _ecl_big_register1(); + struct ecl_timeval now; + ecl_get_internal_real_time(&now); + bignum_set_time(aux_big, start); + bignum_set_time(delta_big, &now); + _ecl_big_sub(delta_big, delta_big, aux_big); + _ecl_big_register_free(aux_big); + return delta_big; +} + +static double +waiting_time(cl_index iteration, struct ecl_timeval *start) +{ + /* Waiting time is smaller than 0.10 s */ + double time; + cl_object top = MAKE_FIXNUM(10 * 1000); + cl_object delta_big = elapsed_time(start); + _ecl_big_div_ui(delta_big, delta_big, iteration); + if (ecl_number_compare(delta_big, top) < 0) { + time = ecl_to_double(delta_big); + } else { + time = 0.10; + } + _ecl_big_register_free(delta_big); + return time; +} + +void +spinlock(cl_index iteration, struct ecl_timeval *start) +{ + ecl_musleep((iteration > 3) ? + waiting_time(iteration, start) : + 0.0, + 1); +} + +void +ecl_wait_on(cl_object (*condition)(cl_object), cl_object o) +{ + cl_env_ptr env = ecl_process_env(); + cl_object process = env->own_process; + struct ecl_timeval start; + ecl_bds_bind(env, @'ext::*interrupts-enabled*', Cnil); + ecl_get_internal_real_time(&start); + CL_UNWIND_PROTECT_BEGIN(env) { + cl_fixnum iteration = 0; + process->process.waiting_for = o; + o->lock.waiter = process; + ecl_bds_bind(env, @'ext::*interrupts-enabled*', Ct); + ecl_check_pending_interrupts(); + do { + spinlock(iteration++, &start); + } while (condition(o) == Cnil); + ecl_bds_unwind1(env); + } CL_UNWIND_PROTECT_EXIT { + process->process.waiting_for = Cnil; + } CL_UNWIND_PROTECT_END; + ecl_bds_unwind1(env); +} + +static void +wakeup_process(cl_object p) +{ + mp_interrupt_process(p, @'+'); +} + +void +ecl_wakeup_waiters(cl_object o, bool all) +{ + cl_object v = cl_core.processes; + cl_index size = v->vector.dim; + cl_index i = size; + cl_index ndx = rand() % size; + while (i--) { + cl_object p = v->vector.self.t[ndx]; + if (!Null(p)) { + if (p->process.waiting_for == o && p->process.active == 1) { + wakeup_process(p); + if (!all) return; + } + } + if (++ndx >= size) + ndx = 0; + } +} diff --git a/src/c/time.d b/src/c/time.d index b6cb86c39..bd74b7198 100755 --- a/src/c/time.d +++ b/src/c/time.d @@ -108,48 +108,8 @@ ecl_get_internal_run_time(struct ecl_timeval *tv) #endif } -static cl_object -bignum_set_time(cl_object bignum, struct ecl_timeval *time) -{ - _ecl_big_set_index(bignum, time->tv_sec); - _ecl_big_mul_ui(bignum, bignum, 1000); - _ecl_big_add_ui(bignum, bignum, (time->tv_usec + 999) / 1000); - return bignum; -} - -static cl_object -elapsed_time(struct ecl_timeval *start) -{ - cl_object delta_big = _ecl_big_register0(); - cl_object aux_big = _ecl_big_register1(); - struct ecl_timeval now; - ecl_get_internal_real_time(&now); - bignum_set_time(aux_big, start); - bignum_set_time(delta_big, &now); - _ecl_big_sub(delta_big, delta_big, aux_big); - _ecl_big_register_free(aux_big); - return delta_big; -} - -static double -waiting_time(cl_index iteration, struct ecl_timeval *start) -{ - /* Waiting time is smaller than 0.10 s */ - double time; - cl_object top = MAKE_FIXNUM(10 * 1000); - cl_object delta_big = elapsed_time(start); - _ecl_big_div_ui(delta_big, delta_big, iteration); - if (ecl_number_compare(delta_big, top) < 0) { - time = ecl_to_double(delta_big); - } else { - time = 0.10; - } - _ecl_big_register_free(delta_big); - return time; -} - -static void -musleep(double time, bool alertable) +void +ecl_musleep(double time, bool alertable) { #ifdef HAVE_NANOSLEEP struct timespec tm; @@ -211,15 +171,6 @@ musleep(double time, bool alertable) #endif } -void -ecl_wait_for(cl_index iteration, struct ecl_timeval *start) -{ - musleep((iteration > 3) ? - waiting_time(iteration, start) : - 0.0, - 1); -} - cl_fixnum ecl_runtime(void) { @@ -247,7 +198,7 @@ cl_sleep(cl_object z) time = 1e-9; } } ECL_WITHOUT_FPE_END; - musleep(time, 0); + ecl_musleep(time, 0); @(return Cnil) } diff --git a/src/configure b/src/configure index 4a451a1b0..69eceee92 100755 --- a/src/configure +++ b/src/configure @@ -4524,7 +4524,7 @@ THREAD_CFLAGS='' THREAD_LIBS='' THREAD_GC_FLAGS='--enable-threads=posix' INSTALL_TARGET='install' -THREAD_OBJ="$THREAD_OBJ threads/process threads/mutex threads/condition_variable" +THREAD_OBJ="$THREAD_OBJ threads/process threads/queue threads/mutex threads/condition_variable" clibs='' SONAME='' SONAME_LDFLAGS='' @@ -15756,7 +15756,7 @@ do cat >>$CONFIG_STATUS <<_ACEOF # First, check the format of the line: cat >"\$tmp/defines.sed" <<\\CEOF -/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*/b def +/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def /^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def b :def diff --git a/src/h/internal.h b/src/h/internal.h index 2c26e7ed1..18aaa5b23 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -450,11 +450,18 @@ struct ecl_timeval { extern void ecl_get_internal_real_time(struct ecl_timeval *time); extern void ecl_get_internal_run_time(struct ecl_timeval *time); -extern void ecl_wait_for(cl_index iteration, struct ecl_timeval *start); +extern void ecl_musleep(double time, bool alertable); #define UTC_time_to_universal_time(x) ecl_plus(ecl_make_integer(x),cl_core.Jan1st1970UT) extern cl_fixnum ecl_runtime(void); +/* threads/mutex.d */ + +#ifdef ECL_THREADS +extern void ecl_wait_on(cl_object (*condition)(cl_object), cl_object o); +extern void ecl_wakeup_waiters(cl_object o, bool all); +#endif + /* threads/rwlock.d */ #ifdef ECL_RWLOCK diff --git a/src/h/object.h b/src/h/object.h index 59a2a99ce..b4410bb52 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -895,12 +895,14 @@ struct ecl_process { cl_object exit_lock; int trap_fpe_bits; cl_object exit_values; + cl_object waiting_for; }; struct ecl_lock { HEADER1(recursive); cl_object name; cl_object owner; /* thread holding the lock or NIL */ + cl_object waiter; cl_fixnum counter; };