Re: thread cancellation, take 2

["Julian Graham" <joolean@gmail.com>]

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

Alright -- I think I've got it working.  After mucking about for a bit
with asyncs, I realized that it makes more sense to evaluate cleanup
handlers in do_thread_exit -- and evaluation should happen there
anyway, since pthreads says cleanup handlers get called when the
thread exits for any reason, not just cancellation.  Duh.

The patch I've attached adds three new public functions:
cancel-thread, push-thread-cleanup, and pop-thread-cleanup.  API
documentation on their behavior is included in the changes.

I've never submitted a patch for Guile before, so I've likely made a
few mistakes in formatting, etc., and I don't really know the vetting
procedure. I hope I've gotten the main bits right, though.  Please let
me know if there are any changes I should make.


On 9/20/07, Julian Graham <joolean@gmail.com> wrote:
> > Would it be possible to defer execution of the Scheme code (cleanup
> > handlers) to after the C cleanup handler has been called?
> >
> > I.e., the C handler would push the Scheme handlers to a list that would
> > be eventually executed, when Guile is back into a "clean", regular
> > state.
>
> Yeah, that would be fine -- except that after the thread is signaled
> for cancellation, it'll never go back into a regular state.  That is,
> I think the next thing that happens is that the thread-local exit
> handlers (on_thread_exit in threads.c) get called -- and I don't think
> that code evaluates queued asyncs (please let me know if it actually
> does!).  And any queued asyncs would have to be evaluated within that
> thread (and in order), because people are going to want to do things
> that have to be done from within a particular thread, like unlock
> mutexes.
>
> > I'd prefer thunks as well, it looks more Schemey.
>
> I agree -- and makes things way easier if it turns out it's possible
> to do this with asyncs.
>

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: thread-cancellation.HEAD.patch --]
[-- Type: text/x-patch; name="thread-cancellation.HEAD.patch", Size: 6708 bytes --]

? thread-cancellation.HEAD.patch
Index: null-threads.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/null-threads.h,v
retrieving revision 1.12
diff -u -r1.12 null-threads.h
--- null-threads.h	17 Apr 2006 00:05:40 -0000	1.12
+++ null-threads.h	23 Sep 2007 04:57:27 -0000
@@ -41,6 +41,7 @@
 #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_sched_yield()                 0
 
 /* Signals
Index: pthread-threads.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/pthread-threads.h,v
retrieving revision 1.15
diff -u -r1.15 pthread-threads.h
--- pthread-threads.h	9 Oct 2006 23:21:00 -0000	1.15
+++ pthread-threads.h	23 Sep 2007 04:57:27 -0000
@@ -35,6 +35,7 @@
 #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_sched_yield                   sched_yield
 
 /* Signals
Index: threads.c
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/threads.c,v
retrieving revision 1.88
diff -u -r1.88 threads.c
--- threads.c	15 Jan 2007 23:35:34 -0000	1.88
+++ threads.c	23 Sep 2007 04:57:31 -0000
@@ -131,6 +131,7 @@
 {
   scm_i_thread *t = SCM_I_THREAD_DATA (obj);
   scm_gc_mark (t->result);
+  scm_gc_mark (t->cleanup_handlers);
   scm_gc_mark (t->join_queue);
   scm_gc_mark (t->dynwinds);
   scm_gc_mark (t->active_asyncs);
@@ -415,6 +416,7 @@
   t->pthread = scm_i_pthread_self ();
   t->handle = SCM_BOOL_F;
   t->result = SCM_BOOL_F;
+  t->cleanup_handlers = SCM_EOL;
   t->join_queue = SCM_EOL;
   t->dynamic_state = SCM_BOOL_F;
   t->dynwinds = SCM_EOL;
@@ -434,6 +436,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;
@@ -473,12 +476,32 @@
   t->block_asyncs = 0;
 }
 
+static SCM handle_cleanup_handler(void *cont, SCM tag, SCM args) {
+  *((int *) cont) = 0;
+  return scm_handle_by_message_noexit(NULL, tag, args);
+  return SCM_UNDEFINED;
+}
+
 /* Perform thread tear-down, in guile mode.
  */
 static void *
 do_thread_exit (void *v)
 {
-  scm_i_thread *t = (scm_i_thread *)v;
+  scm_i_thread *t = (scm_i_thread *) v;
+
+  while(!scm_is_eq(t->cleanup_handlers, SCM_EOL)) 
+    {
+      int cont = 1;
+      SCM ptr = SCM_CAR(t->cleanup_handlers);
+      t->cleanup_handlers = SCM_CDR(t->cleanup_handlers);
+      t->result = scm_internal_catch (SCM_BOOL_T, 
+				      (scm_t_catch_body) scm_call_0, ptr, 
+				      handle_cleanup_handler, &cont);
+      if (!cont)
+	{
+	  break;
+	}
+    }
 
   scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
 
@@ -489,6 +512,7 @@
     ;
 
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
   return NULL;
 }
 
@@ -882,6 +906,78 @@
 }
 #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);
+  if (t == SCM_I_CURRENT_THREAD)
+    {
+      SCM_MISC_ERROR ("cannot cancel the current thread", SCM_EOL);
+    }
+  scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
+  if (!t->canceled)
+    {
+      t->canceled = 1;
+      scm_i_pthread_cancel(t->pthread);
+    }
+  scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+  return SCM_UNDEFINED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_push_thread_cleanup, "push-thread-cleanup", 1, 0, 0,
+	    (SCM proc),
+"Add the thunk @var{proc} to the front of the list of cleanup handlers for "
+"the current thread. These handlers will be called in a LIFO manner when the "
+"current thread exits.")
+#define FUNC_NAME s_scm_push_thread_cleanup
+{
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  if (!scm_is_eq (scm_thunk_p (proc), SCM_BOOL_T))
+    {
+      SCM_MISC_ERROR ("proc must be a thunk", SCM_EOL);
+    }
+  scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
+  thread->cleanup_handlers = scm_cons (proc, thread->cleanup_handlers);
+  scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+  return SCM_BOOL_T;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_pop_thread_cleanup, "pop-thread-cleanup", 0, 1, 0,
+	    (SCM evalp),
+"Remove the most recently added cleanup handler from the current thread's "
+"list of cleanup handlers. If @car{evalp} is specified and evaluates to "
+"true, the cleanup handler will be called as it is removed.")
+#define FUNC_NAME s_scm_pop_thread_cleanup
+{
+  scm_i_thread *thread = SCM_I_CURRENT_THREAD;
+  scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
+  if (!scm_is_eq (thread->cleanup_handlers, SCM_EOL))
+    {
+      SCM ret = SCM_BOOL_T;
+      SCM ptr = SCM_CAR (thread->cleanup_handlers);
+      thread->cleanup_handlers = SCM_CDR (thread->cleanup_handlers);
+      scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+      if (!scm_is_eq (evalp, SCM_BOOL_F))
+	{
+	  ret = scm_call_0 (ptr);
+	}
+      thread->cleanup_handlers = SCM_CDR (thread->cleanup_handlers);
+      return ret;
+    }
+  scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+  return SCM_BOOL_F;
+}
+#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} "
Index: threads.h
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/threads.h,v
retrieving revision 1.48
diff -u -r1.48 threads.h
--- threads.h	17 Apr 2006 00:05:42 -0000	1.48
+++ threads.h	23 Sep 2007 04:57:31 -0000
@@ -49,9 +49,11 @@
 
   SCM handle;
   scm_i_pthread_t pthread;
-  
+
+  SCM cleanup_handlers;
   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_push_thread_cleanup (SCM thunk);
+SCM_API SCM scm_pop_thread_cleanup (SCM evalp);
 SCM_API SCM scm_join_thread (SCM t);
 
 SCM_API SCM scm_make_mutex (void);

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

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