From 5651640d578fa2efa40be4789d9fa61813ccb1fa Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sun, 19 Aug 2012 03:23:03 -0600 Subject: condition variables This implements condition variables for elisp. This needs more tests. --- src/alloc.c | 2 + src/data.c | 17 ++++- src/lisp.h | 9 ++- src/print.c | 12 ++++ src/thread.c | 219 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----- src/thread.h | 16 +++++ 6 files changed, 255 insertions(+), 20 deletions(-) (limited to 'src') diff --git a/src/alloc.c b/src/alloc.c index 80d22d61d66..19b77d567d0 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3106,6 +3106,8 @@ sweep_vectors (void) finalize_one_thread ((struct thread_state *) vector); else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX)) finalize_one_mutex ((struct Lisp_Mutex *) vector); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR)) + finalize_one_condvar ((struct Lisp_CondVar *) vector); next = ADVANCE (vector, nbytes); diff --git a/src/data.c b/src/data.c index b47c2d12aff..e6342caadf1 100644 --- a/src/data.c +++ b/src/data.c @@ -94,7 +94,7 @@ static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; static Lisp_Object Qdefun; -Lisp_Object Qthread, Qmutex; +Lisp_Object Qthread, Qmutex, Qcondition_variable; Lisp_Object Qinteractive_form; @@ -216,6 +216,8 @@ for example, (type-of 1) returns `integer'. */) return Qthread; if (MUTEXP (object)) return Qmutex; + if (CONDVARP (object)) + return Qcondition_variable; return Qvector; case Lisp_Float: @@ -482,6 +484,17 @@ DEFUN ("mutexp", Fmutexp, Smutexp, 1, 1, 0, else return Qnil; } + +DEFUN ("condition-variablep", Fcondition_variablep, Scondition_variablep, + 1, 1, 0, + doc: /* Return t if OBJECT is a condition variable. */) + (Lisp_Object object) +{ + if (CONDVARP (object)) + return Qt; + else + return Qnil; +} /* Extract and set components of lists */ @@ -3117,6 +3130,7 @@ syms_of_data (void) DEFSYM (Qhash_table, "hash-table"); DEFSYM (Qthread, "thread"); DEFSYM (Qmutex, "mutex"); + DEFSYM (Qcondition_variable, "condition-variable"); /* Used by Fgarbage_collect. */ DEFSYM (Qinterval, "interval"); DEFSYM (Qmisc, "misc"); @@ -3161,6 +3175,7 @@ syms_of_data (void) defsubr (&Schar_or_string_p); defsubr (&Sthreadp); defsubr (&Smutexp); + defsubr (&Scondition_variablep); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/lisp.h b/src/lisp.h index 34ecfe697d6..2a75dfcbc7d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -367,6 +367,7 @@ enum pvec_type PVEC_OTHER, PVEC_THREAD, PVEC_MUTEX, + PVEC_CONDVAR, /* These last 4 are special because we OR them in fns.c:internal_equal, so they have to use a disjoint bit pattern: if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE @@ -557,6 +558,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) XUNTAG (a, Lisp_Vectorlike))) #define XTHREAD(a) (eassert (THREADP (a)), (struct thread_state *) XPNTR(a)) #define XMUTEX(a) (eassert (MUTEXP (a)), (struct Lisp_Mutex *) XPNTR(a)) +#define XCONDVAR(a) (eassert (CONDVARP (a)), (struct Lisp_CondVar *) XPNTR(a)) /* Construct a Lisp_Object from a value or address. */ @@ -609,6 +611,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) #define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) #define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) +#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)) /* Convenience macros for dealing with Lisp arrays. */ @@ -1709,6 +1712,7 @@ typedef struct { #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) #define THREADP(x) PSEUDOVECTORP (x, PVEC_THREAD) #define MUTEXP(x) PSEUDOVECTORP (x, PVEC_MUTEX) +#define CONDVARP(x) PSEUDOVECTORP (x, PVEC_CONDVAR) /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) @@ -1833,6 +1837,9 @@ typedef struct { #define CHECK_MUTEX(x) \ CHECK_TYPE (MUTEXP (x), Qmutexp, x) +#define CHECK_CONDVAR(x) \ + CHECK_TYPE (CONDVARP (x), Qcondition_variablep, x) + /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ #define CHECK_NUMBER_CAR(x) \ @@ -2455,7 +2462,7 @@ extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; extern Lisp_Object Qbuffer_or_string_p; extern Lisp_Object Qfboundp; extern Lisp_Object Qchar_table_p, Qvector_or_char_table_p; -extern Lisp_Object Qthreadp, Qmutexp; +extern Lisp_Object Qthreadp, Qmutexp, Qcondition_variablep; extern Lisp_Object Qcdr; diff --git a/src/print.c b/src/print.c index b14a769dc74..78a0707627c 100644 --- a/src/print.c +++ b/src/print.c @@ -1967,6 +1967,18 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } PRINTCHAR ('>'); } + else if (CONDVARP (obj)) + { + strout ("#name)) + print_string (XCONDVAR (obj)->name, printcharfun); + else + { + int len = sprintf (buf, "%p", XCONDVAR (obj)); + strout (buf, len, len, printcharfun); + } + PRINTCHAR ('>'); + } else { ptrdiff_t size = ASIZE (obj); diff --git a/src/thread.c b/src/thread.c index 9c39b84eb50..4657d6a797e 100644 --- a/src/thread.c +++ b/src/thread.c @@ -32,7 +32,7 @@ static struct thread_state *all_threads = &primary_thread; static sys_mutex_t global_lock; -Lisp_Object Qthreadp, Qmutexp; +Lisp_Object Qthreadp, Qmutexp, Qcondition_variablep; @@ -89,36 +89,41 @@ lisp_mutex_init (lisp_mutex_t *mutex) sys_cond_init (&mutex->condition); } -static void -lisp_mutex_lock (lisp_mutex_t *mutex) +static int +lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) { struct thread_state *self; if (mutex->owner == NULL) { mutex->owner = current_thread; - mutex->count = 1; - return; + mutex->count = new_count == 0 ? 1 : new_count; + return 0; } if (mutex->owner == current_thread) { + eassert (new_count == 0); ++mutex->count; - return; + return 0; } self = current_thread; self->wait_condvar = &mutex->condition; - while (mutex->owner != NULL && EQ (self->error_symbol, Qnil)) + while (mutex->owner != NULL && (new_count != 0 + || EQ (self->error_symbol, Qnil))) sys_cond_wait (&mutex->condition, &global_lock); self->wait_condvar = NULL; - post_acquire_global_lock (self); + if (new_count == 0 && !NILP (self->error_symbol)) + return 1; mutex->owner = self; - mutex->count = 1; + mutex->count = new_count == 0 ? 1 : new_count; + + return 1; } -static void +static int lisp_mutex_unlock (lisp_mutex_t *mutex) { struct thread_state *self = current_thread; @@ -127,12 +132,28 @@ lisp_mutex_unlock (lisp_mutex_t *mutex) error ("blah"); if (--mutex->count > 0) - return; + return 0; mutex->owner = NULL; sys_cond_broadcast (&mutex->condition); - post_acquire_global_lock (self); + return 1; +} + +static unsigned int +lisp_mutex_unlock_for_wait (lisp_mutex_t *mutex) +{ + struct thread_state *self = current_thread; + unsigned int result = mutex->count; + + /* Ensured by condvar code. */ + eassert (mutex->owner == current_thread); + + mutex->count = 0; + mutex->owner = NULL; + sys_cond_broadcast (&mutex->condition); + + return result; } static void @@ -141,6 +162,12 @@ lisp_mutex_destroy (lisp_mutex_t *mutex) sys_cond_destroy (&mutex->condition); } +static int +lisp_mutex_owned_p (lisp_mutex_t *mutex) +{ + return mutex->owner == current_thread; +} + DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0, @@ -173,9 +200,10 @@ static void mutex_lock_callback (void *arg) { struct Lisp_Mutex *mutex = arg; + struct thread_state *self = current_thread; - /* This calls post_acquire_global_lock. */ - lisp_mutex_lock (&mutex->mutex); + if (lisp_mutex_lock (&mutex->mutex, 0)) + post_acquire_global_lock (self); } static Lisp_Object @@ -211,9 +239,10 @@ static void mutex_unlock_callback (void *arg) { struct Lisp_Mutex *mutex = arg; + struct thread_state *self = current_thread; - /* This calls post_acquire_global_lock. */ - lisp_mutex_unlock (&mutex->mutex); + if (lisp_mutex_unlock (&mutex->mutex)) + post_acquire_global_lock (self); } DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, @@ -253,6 +282,154 @@ finalize_one_mutex (struct Lisp_Mutex *mutex) +DEFUN ("make-condition-variable", + Fmake_condition_variable, Smake_condition_variable, + 1, 2, 0, + doc: /* Make a condition variable. +A condition variable provides a way for a thread to sleep while +waiting for a state change. + +MUTEX is the mutex associated with this condition variable. +NAME, if given, is the name of this condition variable. The name is +informational only. */) + (Lisp_Object mutex, Lisp_Object name) +{ + struct Lisp_CondVar *condvar; + Lisp_Object result; + + CHECK_MUTEX (mutex); + if (!NILP (name)) + CHECK_STRING (name); + + condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR); + memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond), + 0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar, + cond)); + condvar->mutex = mutex; + condvar->name = name; + sys_cond_init (&condvar->cond); + + XSETCONDVAR (result, condvar); + return result; +} + +static void +condition_wait_callback (void *arg) +{ + struct Lisp_CondVar *cvar = arg; + struct Lisp_Mutex *mutex = XMUTEX (cvar->mutex); + struct thread_state *self = current_thread; + unsigned int saved_count; + Lisp_Object cond; + + XSETCONDVAR (cond, cvar); + current_thread->event_object = cond; + saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex); + /* If we were signalled while unlocking, we skip the wait, but we + still must reacquire our lock. */ + if (NILP (self->error_symbol)) + { + self->wait_condvar = &cvar->cond; + sys_cond_wait (&cvar->cond, &global_lock); + self->wait_condvar = NULL; + } + lisp_mutex_lock (&mutex->mutex, saved_count); + current_thread->event_object = Qnil; + post_acquire_global_lock (self); +} + +DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0, + doc: /* Wait for the condition variable to be notified. +CONDITION is the condition variable to wait on. + +The mutex associated with CONDITION must be held when this is called. +It is an error if it is not held. + +This atomically releases the mutex and waits for CONDITION to be +notified. When `condition-wait' returns, the mutex will again be +locked by this thread. */) + (Lisp_Object condition) +{ + struct Lisp_CondVar *cvar; + struct Lisp_Mutex *mutex; + + CHECK_CONDVAR (condition); + cvar = XCONDVAR (condition); + + mutex = XMUTEX (cvar->mutex); + if (!lisp_mutex_owned_p (&mutex->mutex)) + error ("fixme"); + + flush_stack_call_func (condition_wait_callback, cvar); + + return Qnil; +} + +/* Used to communicate argumnets to condition_notify_callback. */ +struct notify_args +{ + struct Lisp_CondVar *cvar; + int all; +}; + +static void +condition_notify_callback (void *arg) +{ + struct notify_args *na = arg; + struct Lisp_Mutex *mutex = XMUTEX (na->cvar->mutex); + struct thread_state *self = current_thread; + unsigned int saved_count; + Lisp_Object cond; + + XSETCONDVAR (cond, na->cvar); + saved_count = lisp_mutex_unlock_for_wait (&mutex->mutex); + if (na->all) + sys_cond_broadcast (&na->cvar->cond); + else + sys_cond_signal (&na->cvar->cond); + lisp_mutex_lock (&mutex->mutex, saved_count); + post_acquire_global_lock (self); +} + +DEFUN ("condition-notify", Fcondition_notify, Scondition_notify, 1, 2, 0, + doc: /* Notify a condition variable. +This wakes a thread waiting on CONDITION. +If ALL is non-nil, all waiting threads are awoken. + +The mutex associated with CONDITION must be held when this is called. +It is an error if it is not held. + +This atomically releases the mutex when notifying CONDITION. When +`condition-notify' returns, the mutex will again be locked by this +thread. */) + (Lisp_Object condition, Lisp_Object all) +{ + struct Lisp_CondVar *cvar; + struct Lisp_Mutex *mutex; + struct notify_args args; + + CHECK_CONDVAR (condition); + cvar = XCONDVAR (condition); + + mutex = XMUTEX (cvar->mutex); + if (!lisp_mutex_owned_p (&mutex->mutex)) + error ("fixme"); + + args.cvar = cvar; + args.all = !NILP (all); + flush_stack_call_func (condition_notify_callback, &args); + + return Qnil; +} + +void +finalize_one_condvar (struct Lisp_CondVar *condvar) +{ + sys_cond_destroy (&condvar->cond); +} + + + struct select_args { select_func *func; @@ -555,8 +732,8 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0, doc: /* Signal an error in a thread. This acts like `signal', but arranges for the signal to be raised in THREAD. If THREAD is the current thread, acts just like `signal'. -This will interrupt a blocked call to `mutex-lock' or`thread-join' in -the target thread. */) +This will interrupt a blocked call to `mutex-lock', `condition-wait', +or `thread-join' in the target thread. */) (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data) { struct thread_state *tstate; @@ -597,6 +774,7 @@ DEFUN ("thread-blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0, If THREAD is blocked in `thread-join' on a second thread, return that thread. If THREAD is blocked in `mutex-lock', return the mutex. +If THREAD is blocked in `condition-wait', return the condition variable. Otherwise, if THREAD is not blocked, return nil. */) (Lisp_Object thread) { @@ -711,9 +889,14 @@ syms_of_threads (void) defsubr (&Smutex_lock); defsubr (&Smutex_unlock); defsubr (&Smutex_name); + defsubr (&Smake_condition_variable); + defsubr (&Scondition_wait); + defsubr (&Scondition_notify); Qthreadp = intern_c_string ("threadp"); staticpro (&Qthreadp); Qmutexp = intern_c_string ("mutexp"); staticpro (&Qmutexp); + Qcondition_variablep = intern_c_string ("condition-variablep"); + staticpro (&Qcondition_variablep); } diff --git a/src/thread.h b/src/thread.h index 6b66ea4d1c3..989acec6afb 100644 --- a/src/thread.h +++ b/src/thread.h @@ -215,11 +215,27 @@ struct Lisp_Mutex lisp_mutex_t mutex; }; +/* A condition variable as a lisp object. */ +struct Lisp_CondVar +{ + struct vectorlike_header header; + + /* The associated mutex. */ + Lisp_Object mutex; + + /* The name of the condition variable, or nil. */ + Lisp_Object name; + + /* The lower-level condition variable object. */ + sys_cond_t cond; +}; + extern struct thread_state *current_thread; extern void unmark_threads (void); extern void finalize_one_thread (struct thread_state *state); extern void finalize_one_mutex (struct Lisp_Mutex *); +extern void finalize_one_condvar (struct Lisp_CondVar *); extern void init_threads_once (void); extern void init_threads (void); -- cgit v1.2.1