From 8d3566c6a0eb3977c3115ae100a357f8d63cf77e Mon Sep 17 00:00:00 2001
From: Tom Tromey <tromey@redhat.com>
Date: Wed, 15 Aug 2012 13:14:14 -0600
Subject: [PATCH] This adds names to mutexes.  This seemed like a nice
 debugging extension.

---
 src/print.c  | 10 +++++++---
 src/thread.c | 25 ++++++++++++++++---------
 src/thread.h |  9 ++++++++-
 3 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/src/print.c b/src/print.c
index 42e7241ecba..b14a769dc74 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1957,10 +1957,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
 	}
       else if (MUTEXP (obj))
 	{
-	  int len;
 	  strout ("#<mutex ", -1, -1, printcharfun);
-	  len = sprintf (buf, "%p", XMUTEX (obj));
-	  strout (buf, len, len, printcharfun);
+	  if (STRINGP (XMUTEX (obj)->name))
+	    print_string (XMUTEX (obj)->name, printcharfun);
+	  else
+	    {
+	      int len = sprintf (buf, "%p", XMUTEX (obj));
+	      strout (buf, len, len, printcharfun);
+	    }
 	  PRINTCHAR ('>');
 	}
       else
diff --git a/src/thread.c b/src/thread.c
index 80557e5d5ee..9ec418f9871 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -39,16 +39,9 @@ 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,
+DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 1, 0,
        doc: /* FIXME */)
-  (void)
+  (Lisp_Object name)
 {
   struct Lisp_Mutex *mutex;
   Lisp_Object result;
@@ -57,6 +50,7 @@ DEFUN ("make-mutex", Fmake_mutex, Smake_mutex, 0, 0, 0,
   memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex),
 	  0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex,
 						    mutex));
+  mutex->name = name;
   lisp_mutex_init (&mutex->mutex);
 
   XSETMUTEX (result, mutex);
@@ -107,6 +101,18 @@ DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0,
   return Qnil;
 }
 
+DEFUN ("mutex-name", Fmutex_name, Smutex_name, 1, 1, 0,
+       doc: /* FIXME */)
+  (Lisp_Object obj)
+{
+  struct Lisp_Mutex *mutex;
+
+  CHECK_MUTEX (obj);
+  mutex = XMUTEX (obj);
+
+  return mutex->name;
+}
+
 void
 finalize_one_mutex (struct Lisp_Mutex *mutex)
 {
@@ -542,6 +548,7 @@ syms_of_threads (void)
   defsubr (&Smake_mutex);
   defsubr (&Smutex_lock);
   defsubr (&Smutex_unlock);
+  defsubr (&Smutex_name);
 
   Qthreadp = intern_c_string ("threadp");
   staticpro (&Qthreadp);
diff --git a/src/thread.h b/src/thread.h
index d3ec38a22b9..1a193b1e4ae 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -168,7 +168,14 @@ struct thread_state
   struct thread_state *next_thread;
 };
 
-struct Lisp_Mutex;
+struct Lisp_Mutex
+{
+  struct vectorlike_header header;
+
+  Lisp_Object name;
+
+  lisp_mutex_t mutex;
+};
 
 extern struct thread_state *current_thread;
 
-- 
2.11.4.GIT