From d94f6fa5fe69c416c358e338f861da95e00c1196 Mon Sep 17 00:00:00 2001
From: Giuseppe Scrivano <gscrivano@gnu.org>
Date: Sat, 13 Feb 2010 00:42:25 +0100
Subject: [PATCH] Mutex object initial implementation.

---
 src/alloc.c  |  6 ++++++
 src/lisp.h   |  5 +++++
 src/print.c  |  4 ++++
 src/thread.c | 44 ++++++++++++++++++++++++++++++++++++++++++++
 src/thread.h | 10 ++++++++++
 5 files changed, 69 insertions(+)

diff --git a/src/alloc.c b/src/alloc.c
index 2704b680263..cea0bacca3d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3011,6 +3011,12 @@ allocate_process ()
   return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
 }
 
+struct Lisp_Mutex *
+allocate_mutex ()
+{
+  return ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, owner, PVEC_MUTEX);
+}
+
 
 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
        doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
diff --git a/src/lisp.h b/src/lisp.h
index 1670c859b0e..d4392bc7eab 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -353,6 +353,7 @@ enum pvec_type
   PVEC_FONT = 0x200000,
   PVEC_OTHER = 0x400000,
   PVEC_THREAD = 0x800000,
+  PVEC_MUTEX = 0x1000000,
   PVEC_TYPE_MASK = 0xfffe00
 
 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
@@ -592,6 +593,7 @@ extern size_t pure_size;
 #define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR(a))
 #define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR(a))
 #define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR(a))
+#define XMUTEX(a) (eassert (MUTEXP(a)),(struct Lisp_Mutex *) XPNTR(a))
 
 /* Construct a Lisp_Object from a value or address.  */
 
@@ -628,6 +630,7 @@ extern size_t pure_size;
 #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.  */
 
@@ -1639,6 +1642,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))
@@ -2732,6 +2736,7 @@ extern struct Lisp_Hash_Table *allocate_hash_table P_ ((void));
 extern struct window *allocate_window P_ ((void));
 extern struct frame *allocate_frame P_ ((void));
 extern struct Lisp_Process *allocate_process P_ ((void));
+extern struct Lisp_Mutex *allocate_mutex P_ ((void));
 extern struct terminal *allocate_terminal P_ ((void));
 extern int gc_in_progress;
 extern int abort_on_gc;
diff --git a/src/print.c b/src/print.c
index 5c9bd8bfa2b..79020012c08 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2172,6 +2172,10 @@ print_object (obj, printcharfun, escapeflag)
 	    }
 	  PRINTCHAR ('>');
 	}
+      else if (MUTEXP (obj))
+        {
+	      strout ("#<mutex>", -1, -1, printcharfun, 0);
+        }
       else
 	{
 	  EMACS_INT size = XVECTOR (obj)->size;
diff --git a/src/thread.c b/src/thread.c
index 3c3322e9455..32d5f3fb49f 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -365,6 +365,47 @@ DEFUN ("inhibit-yield", Finhibit_yield, Sinhibit_yield, 1, 1, 0,
   return Qnil;
 }
 
+DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 0, 0,
+       doc: /* Make a mutex.  */)
+     ()
+{
+  Lisp_Object ret;
+  struct Lisp_Mutex *mutex = allocate_mutex ();
+  mutex->owner = 0;
+  XSETMUTEX (ret, mutex);
+  return ret;
+}
+
+DEFUN ("mutex-lock", Fmutex_lock, Smutex_lock, 1, 1, 0,
+       doc: /* Lock a mutex.  */)
+     (val)
+     Lisp_Object val;
+{
+  struct Lisp_Mutex *mutex = XMUTEX (val);
+  while (1)
+    {
+      if (mutex->owner == 0 || mutex->owner == pthread_self ())
+        {
+          mutex->owner = pthread_self ();
+          return Qt;
+        }
+
+      thread_yield ();
+    }
+
+  return Qt;
+}
+
+DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0,
+       doc: /* Unlock a mutex.  */)
+     (val)
+     Lisp_Object val;
+{
+  struct Lisp_Mutex *mutex = XMUTEX (val);
+  mutex->owner = 0;
+  return Qt;
+}
+
 int
 thread_select (n, rfd, wfd, xfd, tmo)
   int n;
@@ -447,4 +488,7 @@ syms_of_threads (void)
   defsubr (&Srun_in_thread);
   defsubr (&Syield);
   defsubr (&Sinhibit_yield);
+  defsubr (&Smake_mutex);
+  defsubr (&Smutex_lock);
+  defsubr (&Smutex_unlock);
 }
diff --git a/src/thread.h b/src/thread.h
index e58d2bebfde..41157d03dc3 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -1,5 +1,15 @@
 #include "regex.h"
 
+struct Lisp_Mutex
+{
+  EMACS_UINT size;
+
+  struct Lisp_Vector *v_next;
+
+  /* Thread that owns the mutex.  */
+  pthread_t owner;
+};
+
 struct thread_state
 {
   EMACS_UINT size;
-- 
2.11.4.GIT