unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
From: "Julian Graham" <joolean@gmail.com>
To: "Ludovic Courtès" <ludovic.courtes@laas.fr>
Cc: guile-devel@gnu.org
Subject: Re: thread cancellation, take 2
Date: Wed, 17 Oct 2007 20:41:49 -0400	[thread overview]
Message-ID: <2bc5f8210710171741k51d37e3eha7c1d798f8dec0e@mail.gmail.com> (raw)
In-Reply-To: <2bc5f8210709261939g35dbdbc3g7823dcf3ca843083@mail.gmail.com>

[-- Attachment #1: Type: text/plain, Size: 1214 bytes --]

While testing some of the changes I made for SRFI-18 support, I
noticed a couple of deadlocks in my thread cancellation code.  I've
updated my thread cancellation patch to address them.  Specifically:

* If a thread was interrupted by a cancellation while it was in Guile
mode (i.e., holding its heap mutex), a GC in another thread could
cause a deadlock by grabbing the thread admin mutex and then
attempting to seize the canceled thread's heap mutex -- the canceled
thread only releases its heap mutex once during cancellation (the heap
mutexes are recursive).  I've added a pthread cleanup handler to deal
with this case by releasing a thread's heap mutex before beginning the
exit procedure.

* If the signal delivery thread got launched a little bit too late, it
could be holding its startup mutex and then attempt to grab the
thread_admin_mutex, which could be held by a thread that was in the
process of being canceled and which was trying to obtain the signal
delivery thread's startup mutex.  I've resolved this by forcing the
signal delivery thread to start (if it hasn't already) during thread
cancellation of any thread.

Find attached a new version of the thread cancellation patch.


Regards,
Julian

[-- Attachment #2: thread-cancellation.HEAD.patch-20071017 --]
[-- Type: application/octet-stream, Size: 14928 bytes --]

Index: libguile/null-threads.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/null-threads.h,v
retrieving revision 1.12
diff -a -u -r1.12 null-threads.h
--- libguile/null-threads.h	17 Apr 2006 00:05:40 -0000	1.12
+++ libguile/null-threads.h	18 Oct 2007 00:11:00 -0000
@@ -41,6 +41,9 @@
 #define scm_i_pthread_create(t,a,f,d)       (*(t)=0, (void)(f), ENOSYS)
 #define scm_i_pthread_detach(t)             do { } while (0)
 #define scm_i_pthread_exit(v)               exit(0)
+#define scm_i_pthread_cancel(t)             0
+#define scm_i_pthread_cleanup_push(t,v)     0
+#define scm_i_pthread_cleanup_pop(e)        0
 #define scm_i_sched_yield()                 0
 
 /* Signals
Index: libguile/pthread-threads.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/pthread-threads.h,v
retrieving revision 1.16
diff -a -u -r1.16 pthread-threads.h
--- libguile/pthread-threads.h	10 Oct 2007 16:46:26 -0000	1.16
+++ libguile/pthread-threads.h	18 Oct 2007 00:11:00 -0000
@@ -35,6 +35,9 @@
 #define scm_i_pthread_create                pthread_create
 #define scm_i_pthread_detach                pthread_detach
 #define scm_i_pthread_exit                  pthread_exit
+#define scm_i_pthread_cancel                pthread_cancel
+#define scm_i_pthread_cleanup_push          pthread_cleanup_push
+#define scm_i_pthread_cleanup_pop           pthread_cleanup_pop
 #define scm_i_sched_yield                   sched_yield
 
 /* Signals
Index: libguile/scmsigs.c
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/scmsigs.c,v
retrieving revision 1.97
diff -a -u -r1.97 scmsigs.c
--- libguile/scmsigs.c	7 Mar 2007 23:10:52 -0000	1.97
+++ libguile/scmsigs.c	18 Oct 2007 00:11:01 -0000
@@ -33,6 +33,7 @@
 #include "libguile/eval.h"
 #include "libguile/root.h"
 #include "libguile/vectors.h"
+#include "libguile/threads.h"
 
 #include "libguile/validate.h"
 #include "libguile/scmsigs.h"
@@ -99,6 +100,9 @@
 static SCM signal_handler_asyncs;
 static SCM signal_handler_threads;
 
+scm_i_thread *scm_i_signal_delivery_thread;
+static scm_i_pthread_mutex_t signal_delivery_thread_mutex;
+
 /* saves the original C handlers, when a new handler is installed.
    set to SIG_ERR if the original handler is installed.  */
 #ifdef HAVE_SIGACTION
@@ -185,24 +189,29 @@
 	  if (scm_is_true (h))
 	    scm_system_async_mark_for_thread (h, t);
 	}
+      else if (n == 0)
+	break; /* the signal pipe was closed. */
       else if (n < 0 && errno != EINTR)
 	perror ("error in signal delivery thread");
     }
 
-  return SCM_UNSPECIFIED;	/* not reached */
+  return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
 }
 
 static void
 start_signal_delivery_thread (void)
 {
+  scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
   if (pipe (signal_pipe) != 0)
     scm_syserror (NULL);
-  scm_spawn_thread (signal_delivery_thread, NULL,
-		    scm_handle_by_message, "signal delivery thread");
+  scm_i_signal_delivery_thread = SCM_I_THREAD_DATA 
+    (scm_spawn_thread (signal_delivery_thread, NULL,
+		       scm_handle_by_message, "signal delivery thread"));
+  scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);  
 }
 
-static void
-ensure_signal_delivery_thread ()
+void
+scm_i_ensure_signal_delivery_thread ()
 {
   static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
   scm_i_pthread_once (&once, start_signal_delivery_thread);
@@ -228,8 +237,8 @@
 #endif
 }
 
-static void
-ensure_signal_delivery_thread ()
+void
+scm_i_ensure_signal_delivery_thread ()
 {
   return;
 }
@@ -332,7 +341,7 @@
 	SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
     }
 
-  ensure_signal_delivery_thread ();
+  scm_i_ensure_signal_delivery_thread ();
 
   SCM_CRITICAL_SECTION_START;
   old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
@@ -653,10 +662,29 @@
 \f
 
 void
+scm_i_close_signal_pipe()
+{
+  /* signal_delivery_thread_mutex will only be locked while the signal
+     delivery thread is being launched. The thread that calls this function
+     is already holding the thread admin mutex, so if the delivery thread
+     hasn't been launched at this point, it never will be before shutdown.
+   */
+  scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+  if (scm_i_signal_delivery_thread != NULL) 
+    {
+      close (signal_pipe[1]);
+    }
+  scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
+}
+
+void
 scm_init_scmsigs ()
 {
   int i;
 
+  scm_i_pthread_mutex_init (&signal_delivery_thread_mutex, NULL);
+  scm_i_signal_delivery_thread = NULL;
+
   signal_handlers =
     SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
 				  scm_c_make_vector (NSIG, SCM_BOOL_F)));
Index: libguile/scmsigs.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/scmsigs.h,v
retrieving revision 1.17
diff -a -u -r1.17 scmsigs.h
--- libguile/scmsigs.h	17 Apr 2006 00:05:40 -0000	1.17
+++ libguile/scmsigs.h	18 Oct 2007 00:11:01 -0000
@@ -41,6 +41,9 @@
 SCM_API SCM scm_raise (SCM sig);
 SCM_API void scm_init_scmsigs (void);
 
+SCM_API void scm_i_close_signal_pipe (void);
+SCM_API void scm_i_ensure_signal_delivery_thread (void);
+
 #endif  /* SCM_SCMSIGS_H */
 
 /*
Index: libguile/threads.c
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/threads.c,v
retrieving revision 1.89
diff -a -u -r1.89 threads.c
--- libguile/threads.c	2 Oct 2007 16:06:25 -0000	1.89
+++ libguile/threads.c	18 Oct 2007 00:11:03 -0000
@@ -48,6 +48,7 @@
 #include "libguile/continuations.h"
 #include "libguile/gc.h"
 #include "libguile/init.h"
+#include "libguile/scmsigs.h"
 
 #ifdef __MINGW32__
 #ifndef ETIMEDOUT
@@ -131,6 +132,7 @@
 {
   scm_i_thread *t = SCM_I_THREAD_DATA (obj);
   scm_gc_mark (t->result);
+  scm_gc_mark (t->cleanup_handler);
   scm_gc_mark (t->join_queue);
   scm_gc_mark (t->dynwinds);
   scm_gc_mark (t->active_asyncs);
@@ -405,6 +407,8 @@
 
 static SCM scm_i_default_dynamic_state;
 
+extern scm_i_thread *scm_i_signal_delivery_thread;
+
 /* Perform first stage of thread initialisation, in non-guile mode.
  */
 static void
@@ -415,6 +419,7 @@
   t->pthread = scm_i_pthread_self ();
   t->handle = SCM_BOOL_F;
   t->result = SCM_BOOL_F;
+  t->cleanup_handler = SCM_BOOL_F;
   t->join_queue = SCM_EOL;
   t->dynamic_state = SCM_BOOL_F;
   t->dynwinds = SCM_EOL;
@@ -434,6 +439,7 @@
   scm_i_pthread_mutex_init (&t->heap_mutex, NULL);
   t->clear_freelists_p = 0;
   t->gc_running_p = 0;
+  t->canceled = 0;
   t->exited = 0;
 
   t->freelist = SCM_EOL;
@@ -478,7 +484,16 @@
 static void *
 do_thread_exit (void *v)
 {
-  scm_i_thread *t = (scm_i_thread *)v;
+  scm_i_thread *t = (scm_i_thread *) v;
+
+  if (!scm_is_false (t->cleanup_handler))
+    {
+      SCM ptr = t->cleanup_handler;
+      t->cleanup_handler = SCM_BOOL_F;
+      t->result = scm_internal_catch (SCM_BOOL_T, 
+				      (scm_t_catch_body) scm_call_0, ptr,
+				      scm_handle_by_message_noexit, NULL);
+    }
 
   scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
 
@@ -489,6 +504,7 @@
     ;
 
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
   return NULL;
 }
 
@@ -496,10 +512,15 @@
 on_thread_exit (void *v)
 {
   /* This handler is executed in non-guile mode.  */
-  scm_i_thread *t = (scm_i_thread *)v, **tp;
+  scm_i_thread *t = (scm_i_thread *) v, **tp;
 
   scm_i_pthread_setspecific (scm_i_thread_key, v);
 
+  /* Ensure the signal handling thread has been launched, because we might be 
+     shutting it down. */
+
+  scm_i_ensure_signal_delivery_thread ();
+
   /* Unblocking the joining threads needs to happen in guile mode
      since the queue is a SCM data structure.  */
   scm_with_guile (do_thread_exit, v);
@@ -515,6 +536,17 @@
 	break;
       }
   thread_count--;
+
+  /* If there's only one other thread, it could be the signal delivery thread,
+     so we need to notify it to shut down by closing its read pipe. If it's not
+     the signal delivery thread, then closing the read pipe isn't going to 
+     hurt.
+  */
+  if (thread_count <= 1)
+    {
+      scm_i_close_signal_pipe ();
+    }
+  
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
 
   scm_i_pthread_setspecific (scm_i_thread_key, NULL);
@@ -684,17 +716,30 @@
 				      scm_i_default_dynamic_state);
 }
 
+static void
+scm_leave_guile_cleanup (void *x)
+{
+  scm_leave_guile ();
+}
+
 void *
-scm_i_with_guile_and_parent (void *(*func)(void *), void *data,
-			     SCM parent)
+scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent)
 {
   void *res;
   int really_entered;
   SCM_STACKITEM base_item;
+
   really_entered = scm_i_init_thread_for_guile (&base_item, parent);
-  res = scm_c_with_continuation_barrier (func, data);
   if (really_entered)
-    scm_leave_guile ();
+    {
+      scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL);
+      res = scm_c_with_continuation_barrier (func, data);
+      scm_i_pthread_cleanup_pop (0);
+      scm_leave_guile ();
+    }
+  else 
+    res = scm_c_with_continuation_barrier (func, data);
+
   return res;
 }
 
@@ -880,6 +925,74 @@
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
+	    (SCM thread),
+"Asynchronously force the target @var{thread} to terminate. @var{thread} "
+"cannot be the current thread, and if @var{thread} has already terminated or "
+"been signaled to terminate, this function is a no-op.")
+#define FUNC_NAME s_scm_cancel_thread
+{
+  scm_i_thread *t = NULL;
+
+  SCM_VALIDATE_THREAD (1, thread);
+  t = SCM_I_THREAD_DATA (thread);
+  scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
+  if (!t->canceled)
+    {
+      t->canceled = 1;
+      scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+      scm_i_pthread_cancel (t->pthread);
+    }
+  else 
+    {
+      scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+    }
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_thread_cleanup_x, "set-thread-cleanup!", 2, 0, 0,
+	    (SCM thread, SCM proc),
+"Set the thunk @var{proc} as the cleanup handler for the thread @var{thread}. "
+"This handler will be called when the thread exits.")
+#define FUNC_NAME s_scm_set_thread_cleanup_x
+{
+  scm_i_thread *t;
+
+  SCM_VALIDATE_THREAD (1, thread);
+  if (scm_is_true (proc) && scm_is_false (scm_thunk_p (proc)))    
+    {
+      SCM_MISC_ERROR ("proc must be a thunk", SCM_EOL);
+    }
+
+  scm_i_pthread_mutex_lock (&thread_admin_mutex);
+  t = SCM_I_THREAD_DATA (thread);
+  if (!(t->exited || t->canceled))
+    {
+      t->cleanup_handler = proc;
+    }
+  scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_current_thread_cleanup, "thread-cleanup", 1, 0, 0,
+	    (SCM thread),
+"Return the cleanup handler installed for the thread @var{thread}.")
+#define FUNC_NAME s_scm_current_thread_cleanup
+{
+  scm_i_thread *t;
+  SCM ret;
+
+  SCM_VALIDATE_THREAD (1, thread);
+  scm_i_pthread_mutex_lock (&thread_admin_mutex);
+  t = SCM_I_THREAD_DATA (thread);
+  ret = (t->exited || t->canceled) ? SCM_BOOL_F : t->cleanup_handler;
+  scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+  return ret;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
 	    (SCM thread),
 "Suspend execution of the calling thread until the target @var{thread} "
@@ -1537,8 +1650,11 @@
   l = &list;
   for (t = all_threads; t && n > 0; t = t->next_thread)
     {
-      SCM_SETCAR (*l, t->handle);
-      l = SCM_CDRLOC (*l);
+      if (t != scm_i_signal_delivery_thread)
+	{
+	  SCM_SETCAR (*l, t->handle);
+	  l = SCM_CDRLOC (*l);
+	}
       n--;
     }
   *l = SCM_EOL;
@@ -1692,6 +1808,7 @@
   scm_set_smob_free (scm_tc16_condvar, fat_cond_free);
 
   scm_i_default_dynamic_state = SCM_BOOL_F;
+  scm_i_pthread_setspecific (scm_i_thread_key, SCM_I_CURRENT_THREAD);
   guilify_self_2 (SCM_BOOL_F);
   threads_initialized_p = 1;
 
Index: libguile/threads.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/threads.h,v
retrieving revision 1.48
diff -a -u -r1.48 threads.h
--- libguile/threads.h	17 Apr 2006 00:05:42 -0000	1.48
+++ libguile/threads.h	18 Oct 2007 00:11:03 -0000
@@ -49,9 +49,11 @@
 
   SCM handle;
   scm_i_pthread_t pthread;
-  
+
+  SCM cleanup_handler;
   SCM join_queue;
   SCM result;
+  int canceled;
   int exited;
 
   SCM sleep_object;
@@ -153,6 +155,9 @@
 
 SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
 SCM_API SCM scm_yield (void);
+SCM_API SCM scm_cancel_thread (SCM t);
+SCM_API SCM scm_set_thread_cleanup_x (SCM thread, SCM proc);
+SCM_API SCM scm_current_thread_cleanup (SCM thread);
 SCM_API SCM scm_join_thread (SCM t);
 
 SCM_API SCM scm_make_mutex (void);
Index: test-suite/tests/threads.test
===================================================================
RCS file: /sources/guile/guile/guile-core/test-suite/tests/threads.test,v
retrieving revision 1.6
diff -a -u -r1.6 threads.test
--- test-suite/tests/threads.test	17 Jun 2006 23:08:23 -0000	1.6
+++ test-suite/tests/threads.test	18 Oct 2007 00:11:04 -0000
@@ -133,4 +133,54 @@
 				(lambda (n) (set! result (cons n result)))
 				(lambda (n) (* 2 n))
 				'(0 1 2 3 4 5))
-	    (equal? result '(10 8 6 4 2 0)))))))
+	    (equal? result '(10 8 6 4 2 0)))))
+
+      ;; 
+      ;; thread cancellation
+      ;;
+
+      (with-test-prefix "cancel-thread"
+	
+        (pass-if "cancel succeeds"
+	  (let ((m (make-mutex)))
+	    (lock-mutex m)
+	    (let ((t (begin-thread (begin (lock-mutex m) 'foo))))
+	      (cancel-thread t)
+	      (join-thread t)
+	      #t)))
+
+	(pass-if "handler result passed to join"
+	  (let ((m (make-mutex)))
+	    (lock-mutex m)
+	    (let ((t (begin-thread (lock-mutex m))))
+	      (set-thread-cleanup! t (lambda () 'foo))
+	      (cancel-thread t)
+	      (eq? (join-thread t) 'foo))))
+
+	(pass-if "can cancel self"
+	  (let ((m (make-mutex)))
+	    (lock-mutex m)
+	    (let ((t (begin-thread (begin 
+				     (set-thread-cleanup! (current-thread)
+							  (lambda () 'foo))
+				     (cancel-thread (current-thread))
+				     (lock-mutex m)))))
+	      (eq? (join-thread t) 'foo))))
+
+	(pass-if "handler supplants final expr"
+	  (let ((t (begin-thread (begin (set-thread-cleanup! (current-thread)
+							     (lambda () 'bar))
+					'foo))))
+	    (eq? (join-thread t) 'bar)))
+
+	(pass-if "remove handler by setting false"
+	  (let ((m (make-mutex)))
+	    (lock-mutex m)
+	    (let ((t (begin-thread (lock-mutex m) 'bar)))
+	      (set-thread-cleanup! t (lambda () 'foo))
+	      (set-thread-cleanup! t #f)
+	      (unlock-mutex m)
+	      (eq? (join-thread t) 'bar))))
+	
+	(pass-if "initial handler is false"
+	  (not (thread-cleanup (current-thread)))))))

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

  reply	other threads:[~2007-10-18  0:41 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2007-09-20 14:30 thread cancellation, take 2 Julian Graham
2007-09-20 15:18 ` Ludovic Courtès
2007-09-20 15:36   ` Julian Graham
2007-09-23  5:16     ` Julian Graham
2007-09-23 10:42       ` Ludovic Courtès
2007-09-23 18:39         ` Julian Graham
2007-09-24 11:42           ` Ludovic Courtès
2007-09-24 15:39             ` Julian Graham
2007-09-24 20:17               ` Julian Graham
2007-09-26  4:03               ` Ludovic Courtès
2007-09-27  2:39                 ` Julian Graham
2007-10-18  0:41                   ` Julian Graham [this message]
2007-10-20 11:12                     ` Ludovic Courtès
2007-10-20 13:02                     ` Ludovic Courtès
2007-10-20 22:19                       ` Julian Graham
2007-10-21 13:03                         ` Ludovic Courtès
2007-10-21 13:11                           ` Ludovic Courtès
2007-10-23 14:16                             ` Julian Graham
2007-10-24  2:35                               ` Julian Graham
2007-10-29 22:04                                 ` Ludovic Courtès
2007-10-29 22:20                                   ` Julian Graham
2007-10-29 23:23                                     ` Neil Jerram
2007-10-30  9:35                                       ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=2bc5f8210710171741k51d37e3eha7c1d798f8dec0e@mail.gmail.com \
    --to=joolean@gmail.com \
    --cc=guile-devel@gnu.org \
    --cc=ludovic.courtes@laas.fr \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).