[Top][All Lists]
[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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [PATCH 07/10] mutex implementation,
Tom Tromey <=