emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH 07/10] mutex implementation


From: Tom Tromey
Subject: [PATCH 07/10] mutex implementation
Date: Thu, 09 Aug 2012 13:42:37 -0600
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux)

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 ("#<mutex ", -1, -1, printcharfun);
+         len = sprintf (buf, "%p", XMUTEX (obj));
+         strout (buf, len, len, printcharfun);
+         PRINTCHAR ('>');
+       }
       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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]