From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tom Tromey Newsgroups: gmane.emacs.devel Subject: [PATCH 07/10] mutex implementation Date: Thu, 09 Aug 2012 13:42:37 -0600 Message-ID: <87628retsi.fsf@fleche.redhat.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1344541370 13717 80.91.229.3 (9 Aug 2012 19:42:50 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 9 Aug 2012 19:42:50 +0000 (UTC) To: Emacs discussions Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Aug 09 21:42:50 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SzYd5-0002Ss-KG for ged-emacs-devel@m.gmane.org; Thu, 09 Aug 2012 21:42:47 +0200 Original-Received: from localhost ([::1]:50090 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SzYd4-00036g-RP for ged-emacs-devel@m.gmane.org; Thu, 09 Aug 2012 15:42:46 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:47168) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SzYd1-00036Q-FL for emacs-devel@gnu.org; Thu, 09 Aug 2012 15:42:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SzYcz-0005UQ-Bp for emacs-devel@gnu.org; Thu, 09 Aug 2012 15:42:43 -0400 Original-Received: from mx1.redhat.com ([209.132.183.28]:51700) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SzYcz-0005UK-2s for emacs-devel@gnu.org; Thu, 09 Aug 2012 15:42:41 -0400 Original-Received: from int-mx11.intmail.prod.int.phx2.redhat.com (int-mx11.intmail.prod.int.phx2.redhat.com [10.5.11.24]) by mx1.redhat.com (8.14.4/8.14.4) with ESMTP id q79Jge87016007 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK) for ; Thu, 9 Aug 2012 15:42:40 -0400 Original-Received: from barimba (ovpn01.gateway.prod.ext.phx2.redhat.com [10.5.9.1]) by int-mx11.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id q79JgcEB011087 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES128-SHA bits=128 verify=NO); Thu, 9 Aug 2012 15:42:38 -0400 X-Attribution: Tom User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux) X-Scanned-By: MIMEDefang 2.68 on 10.5.11.24 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 209.132.183.28 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:152381 Archived-At: This supplies the mutex implementation for Emacs Lisp. A lisp mutex is implemented using a condition variable, so that we can interrupt a mutex-lock operation by calling thread-signal on the blocking thread. I did things this way because pthread_mutex_lock can't readily be interrupted. --- src/alloc.c | 2 + src/data.c | 15 ++++++++++- src/lisp.h | 9 +++++- src/print.c | 8 +++++ src/thread.c | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++- src/thread.h | 3 ++ 6 files changed, 117 insertions(+), 3 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index d114202..67a0d2f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3096,6 +3096,8 @@ sweep_vectors (void) if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD)) finalize_one_thread ((struct thread_state *) vector); + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX)) + finalize_one_mutex ((struct Lisp_Mutex *) vector); next = ADVANCE (vector, nbytes); diff --git a/src/data.c b/src/data.c index 162c46e..b3768a3 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; +Lisp_Object Qthread, Qmutex; Lisp_Object Qinteractive_form; @@ -214,6 +214,8 @@ for example, (type-of 1) returns `integer'. */) return Qfont_object; if (THREADP (object)) return Qthread; + if (MUTEXP (object)) + return Qmutex; return Qvector; case Lisp_Float: @@ -471,6 +473,15 @@ DEFUN ("threadp", Fthreadp, Sthreadp, 1, 1, 0, return Qnil; } +DEFUN ("mutexp", Fmutexp, Smutexp, 1, 1, 0, + doc: /* Return t if OBJECT is a mutex. */) + (Lisp_Object object) +{ + if (MUTEXP (object)) + return Qt; + else + return Qnil; +} /* Extract and set components of lists */ @@ -3103,6 +3114,7 @@ syms_of_data (void) DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); DEFSYM (Qthread, "thread"); + DEFSYM (Qmutex, "mutex"); /* Used by Fgarbage_collect. */ DEFSYM (Qinterval, "interval"); DEFSYM (Qmisc, "misc"); @@ -3146,6 +3158,7 @@ syms_of_data (void) defsubr (&Sbyte_code_function_p); defsubr (&Schar_or_string_p); defsubr (&Sthreadp); + defsubr (&Smutexp); defsubr (&Scar); defsubr (&Scdr); defsubr (&Scar_safe); diff --git a/src/lisp.h b/src/lisp.h index c00b775..7aef74f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -365,6 +365,7 @@ enum pvec_type PVEC_SUBR, PVEC_OTHER, PVEC_THREAD, + PVEC_MUTEX, /* 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 @@ -554,6 +555,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) ((struct Lisp_Bool_Vector *) \ 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)) /* Construct a Lisp_Object from a value or address. */ @@ -605,6 +607,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) #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)) /* Convenience macros for dealing with Lisp arrays. */ @@ -1704,6 +1707,7 @@ typedef struct { #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) #define THREADP(x) PSEUDOVECTORP (x, PVEC_THREAD) +#define MUTEXP(x) PSEUDOVECTORP (x, PVEC_MUTEX) /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) @@ -1825,6 +1829,9 @@ typedef struct { #define CHECK_THREAD(x) \ CHECK_TYPE (THREADP (x), Qthreadp, x) +#define CHECK_MUTEX(x) \ + CHECK_TYPE (MUTEXP (x), Qmutexp, 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) \ @@ -2447,7 +2454,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; +extern Lisp_Object Qthreadp, Qmutexp; extern Lisp_Object Qcdr; diff --git a/src/print.c b/src/print.c index d879239..ce917bc 100644 --- a/src/print.c +++ b/src/print.c @@ -1955,6 +1955,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } PRINTCHAR ('>'); } + else if (MUTEXP (obj)) + { + int len; + strout ("#'); + } else { ptrdiff_t size = ASIZE (obj); diff --git a/src/thread.c b/src/thread.c index 5da2e10..80557e5 100644 --- a/src/thread.c +++ b/src/thread.c @@ -35,7 +35,83 @@ static struct thread_state *all_threads = &primary_thread; sys_mutex_t global_lock; -Lisp_Object Qthreadp; +Lisp_Object Qthreadp, Qmutexp; + + + +struct Lisp_Mutex +{ + struct vectorlike_header header; + + lisp_mutex_t mutex; +}; + +DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 0, 0, + doc: /* FIXME */) + (void) +{ + struct Lisp_Mutex *mutex; + Lisp_Object result; + + mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX); + memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex), + 0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex, + mutex)); + lisp_mutex_init (&mutex->mutex); + + XSETMUTEX (result, mutex); + return result; +} + +static void +mutex_lock_callback (void *arg) +{ + struct Lisp_Mutex *mutex = arg; + + /* This calls post_acquire_global_lock. */ + lisp_mutex_lock (&mutex->mutex); +} + +DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object obj) +{ + struct Lisp_Mutex *mutex; + + CHECK_MUTEX (obj); + mutex = XMUTEX (obj); + + flush_stack_call_func (mutex_lock_callback, mutex); + return Qnil; +} + +static void +mutex_unlock_callback (void *arg) +{ + struct Lisp_Mutex *mutex = arg; + + /* This calls post_acquire_global_lock. */ + lisp_mutex_unlock (&mutex->mutex); +} + +DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, + doc: /* FIXME */) + (Lisp_Object obj) +{ + struct Lisp_Mutex *mutex; + + CHECK_MUTEX (obj); + mutex = XMUTEX (obj); + + flush_stack_call_func (mutex_unlock_callback, mutex); + return Qnil; +} + +void +finalize_one_mutex (struct Lisp_Mutex *mutex) +{ + lisp_mutex_destroy (&mutex->mutex); +} @@ -463,7 +539,12 @@ syms_of_threads (void) defsubr (&Sthread_alive_p); defsubr (&Sthread_join); defsubr (&Sall_threads); + defsubr (&Smake_mutex); + defsubr (&Smutex_lock); + defsubr (&Smutex_unlock); Qthreadp = intern_c_string ("threadp"); staticpro (&Qthreadp); + Qmutexp = intern_c_string ("mutexp"); + staticpro (&Qmutexp); } diff --git a/src/thread.h b/src/thread.h index 3b53331..d3ec38a 100644 --- a/src/thread.h +++ b/src/thread.h @@ -168,6 +168,8 @@ struct thread_state struct thread_state *next_thread; }; +struct Lisp_Mutex; + extern struct thread_state *current_thread; extern sys_mutex_t global_lock; @@ -175,6 +177,7 @@ extern void post_acquire_global_lock (struct thread_state *); extern void unmark_threads (void); extern void finalize_one_thread (struct thread_state *state); +extern void finalize_one_mutex (struct Lisp_Mutex *); extern void init_threads_once (void); extern void init_threads (void); -- 1.7.7.6