thread cancellation, take 2

thread cancellation, take 2

[Julian Graham]

Hi Guilers,

  A while back I did some work on introducing a thread cancellation
API into Guile's thread code.  At the time, the thread refactor for
1.8 hadn't yet happened, and I didn't really know enough about Guile
internals to get anything working.  I came back to my code recently
and made another attempt to integrate it, and I STILL couldn't make it
work, but now at least I think I know the right questions to ask.

  What I had in mind for thread cancellation is a set of three
functions that mirrors the pthreads API: cancel-thread,
push-thread-cleanup, and pop-thread-cleanup (as with pthreads,
push-thread-cleanup and pop-thread-cleanup respectively add and remove
expressions to and from a stack that is evaluated at the time
cancel-thread is called).  My implementation involves installing a
real pthreads cancellation handler that manages evaluation of Scheme
cleanup handlers and some thread shutdown behavior (although most of
this is handled by the new on_thread_exit stuff).  The problem I'm
having comes, I think, when I try to evaluate the items on the cleanup
list -- because the cancellation handler stack is the result of a
non-local exit from Guile's normal execution, I think there's
something wrong with the state of the stack boundaries or registers
that makes the GC freak out (heap corruption, I think, leading to a
double free() somewhere down the road) when I do an eval in that
context (whether or not I'm in Guile mode).  So: Is there a way to
safely evaluate SCMs from C after a JMP into a weird context?  (I
imagine the on_thread_exit code is called in a similar state, but it
only superficially manipulates SCM values...)  I've tried explicitly
resetting the top and base pointers of the stack, as well as updating
the register window, but that didn't seem to help.

  (At the time I asked about this originally, Marius Vollmer suggested
that cancellation be implemented as a system-async -- I think that
approach leaves us with the same issues regarding the GC / stack,
especially now that Guile threads are isomorphic to pthreads.)

  On a related note, do you guys have any preferences as to the
behavior of cancel-thread?  The way I've got it now, joining threads
will receive the value of the final expression in the cleanup-handler
list as the "result" of the canceled thread.  Does that make sense?
Also, should the items in the cleanup-handlers list be S-exprs or
should I limit them to being thunks (kind of leaning toward the latter
right now...)?


Thanks,
Julian


P.S. Here's a link to the thread from when I first tried to do this:

http://lists.gnu.org/archive/html/guile-devel/2004-10/msg00075.html


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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi,

"Julian Graham" <joolean@gmail.com> writes:

> So: Is there a way to safely evaluate SCMs from C after a JMP into a
> weird context?  (I imagine the on_thread_exit code is called in a
> similar state, but it only superficially manipulates SCM values...)

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.

>   (At the time I asked about this originally, Marius Vollmer suggested
> that cancellation be implemented as a system-async -- I think that
> approach leaves us with the same issues regarding the GC / stack,
> especially now that Guile threads are isomorphic to pthreads.)

Indeed, some form of deferred execution appears to be needed here, so
that Scheme code is not evaluated right from the C cleanup handler.

Now, if system asyncs can do the job, then it's better to use them
rather than some ad hoc mechanism as I suggested above.

>   On a related note, do you guys have any preferences as to the
> behavior of cancel-thread?  The way I've got it now, joining threads
> will receive the value of the final expression in the cleanup-handler
> list as the "result" of the canceled thread.  Does that make sense?

Sounds good.

> Also, should the items in the cleanup-handlers list be S-exprs or
> should I limit them to being thunks (kind of leaning toward the latter
> right now...)?

I'd prefer thunks as well, it looks more Schemey.

Hope this helps,
Ludovic.


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

Re: thread cancellation, take 2

[Julian Graham]

> 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.


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

Re: thread cancellation, take 2

[Julian Graham]

[-- 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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi Julian,

"Julian Graham" <joolean@gmail.com> writes:

> 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.

Good!

> 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.

Thinking a bit more about it, maybe we could let users handle the list
of handlers if needed.  That is, we'd have just
`set-thread-cleanup-procedure!' (a two-argument procedure whose first
arg is a thread) and `thread-cleanup-procedure' (a one-argument
procedure); users who have cleanup code spread over several procedure
would provide a procedure that iterates over such pieces of code.  That
would keep Guile's built-in mechanisms minimal.

What do you think?

> 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.

First, you'll need to assign copyright to the FSF so that we can
incorporate your changes (I'll send you the relevant stuff off-line).
Then, you need to make sure your code follows the GNU Standards as much
as possible (a few comments follow).  Also, please add a few test cases
to `threads.test' that exercise the new API.

I think the patch adds a useful feature so, unless someone raises an
objection, I'd be OK to apply it to HEAD when you're done with the
copyright paperwork.

> +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;
> +}

The second `return' is superfluous.  Also, for clarity and consistency
with the GCS, the function should rather read:

  static SCM
  cleanup_handler_error_handler (void *cont, SCM tag, SCM args)
  {
    int *continue_p = (int *) cont;

    *continue_p = 0;

    return scm_handle_by_message_noexit (NULL, tag, args);
  }

But if you agree with the change I suggested above (removing the list of
handlers), you no longer need that function: you can just use
`scm_handle_by_message_noexit ()' directly.

> +  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);

Please add a whitespace before opening parentheses.

> +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.")

Better indent the doc string.

Thanks,
Ludovic.



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

Re: thread cancellation, take 2

[Julian Graham]

> Thinking a bit more about it, maybe we could let users handle the list
> of handlers if needed.  That is, we'd have just
> `set-thread-cleanup-procedure!' (a two-argument procedure whose first
> arg is a thread) and `thread-cleanup-procedure' (a one-argument
> procedure); users who have cleanup code spread over several procedure
> would provide a procedure that iterates over such pieces of code.  That
> would keep Guile's built-in mechanisms minimal.
>
> What do you think?

Well, in the use case for the native pthread_cancel implementation, it
makes a lot of sense to treat the handler list as a stack.  That is,
you have something like:

[LOCK MUTEX 1]
pthread_cleanup_push([UNLOCK MUTEX 1])
[ ...CODE CONTAINING CANCELLATION POINTS... ]
[LOCK MUTEX 2]
pthread_cleanup_push([UNLOCK MUTEX 2])
[ ... ]
pthread_cleanup_pop()
[UNLOCK MUTEX 2]
[ ... ]
pthread_cleanup_pop()
[UNLOCK MUTEX 1]


What's useful about this is that you can have several resources at
different levels of nesting that need to be cleaned up at cancellation
time, but you only need to worry about pushing and popping handlers
within your own scope.  If people feel that managing the entire list
at once is more Scheme-y, though, I can change it.

> First, you'll need to assign copyright to the FSF so that we can
> incorporate your changes (I'll send you the relevant stuff off-line).
> Then, you need to make sure your code follows the GNU Standards as much
> as possible (a few comments follow).  Also, please add a few test cases
> to `threads.test' that exercise the new API.

Great -- I'll deal with the paperwork, add tests, and clean up the
code as you've suggested.  I'll send the revisions to you offline, if
that's okay.


Thanks,
Julian


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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi,

"Julian Graham" <joolean@gmail.com> writes:

> What's useful about this is that you can have several resources at
> different levels of nesting that need to be cleaned up at cancellation
> time, but you only need to worry about pushing and popping handlers
> within your own scope.  If people feel that managing the entire list
> at once is more Scheme-y, though, I can change it.

I find it more elegant to use closures to that end.  I.e., when
installing a handler, you'd write something like this:

  (let ((cleanup (thread-cleanup-procedure (current-thread))))
    (set-thread-cleanup-procedure! (current-thread)
                                   (lambda ()
                                     ;; invoke previous handler
                                     (if (procedure? cleanup)
                                         (cleanup))
                                     ;; clean up...
                                     )))

There's a race here in case multiple threads try to change the cleanup
procedure associated with that particular thread at the same time, but I
suppose it is not an issue in practice.

> Great -- I'll deal with the paperwork, add tests, and clean up the
> code as you've suggested.  I'll send the revisions to you offline, if
> that's okay.

Please post updated patches on the list as well so others get a chance
to review them.

Thanks!

Ludovic.


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

Re: thread cancellation, take 2

[Julian Graham]

> I find it more elegant to use closures to that end.  I.e., when
> installing a handler, you'd write something like this:
>
>   (let ((cleanup (thread-cleanup-procedure (current-thread))))
>     (set-thread-cleanup-procedure! (current-thread)
>                                    (lambda ()
>                                      ;; invoke previous handler
>                                      (if (procedure? cleanup)
>                                          (cleanup))
>                                      ;; clean up...
>                                      )))
>
> There's a race here in case multiple threads try to change the cleanup
> procedure associated with that particular thread at the same time, but I
> suppose it is not an issue in practice.

Fair enough, re: closures.  But why should callers outside the current
thread be able to access that thread's cleanup handler procedure?
Maybe this isn't a realistic issue, but you could use this to "inject"
arbitrary code into a separate thread by setting the cleanup procedure
and immediately canceling the thread.  Why not treat the handler as
thread-specific data?


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

Re: thread cancellation, take 2

[Julian Graham]

On a related note, if it's okay with everyone, I'd like to add a
thread-exit function in the next revision of this patch -- we're just
so close to SRFI-18 compatibility, and that would take us the last few
steps, I think.

Unfortunately, it doesn't seem like calling pthread_exit doesn't seem
to do the trick, at least not in the main REPL thread -- it puts the
process into a zombie state.  It works in threads spawned by the REPL,
and it works when you call it in such a way that the REPL doesn't get
started up (e.g., guile -c "(exit-thread)").  I suspect this has
everything to do with the signal delivery thread, but I'm struggling
with the rest.  Why would the fact that the signal delivery thread is
left listening on a closed pipe make the process into a zombie?
Exiting the entire process seems to work, so I could check to see
whether the calling thread is the only active thread and then call
exit(thread->result) if it is, but that's rather inelegant.  (Does it
even make sense to let people exit the REPL thread?)  Maybe we should
mark certain special threads internally as being, for example, the
REPL or the signal delivery thread, etc.

Can someone shed some light?  I feel stupid.


On 9/24/07, Julian Graham <joolean@gmail.com> wrote:
> > I find it more elegant to use closures to that end.  I.e., when
> > installing a handler, you'd write something like this:
> >
> >   (let ((cleanup (thread-cleanup-procedure (current-thread))))
> >     (set-thread-cleanup-procedure! (current-thread)
> >                                    (lambda ()
> >                                      ;; invoke previous handler
> >                                      (if (procedure? cleanup)
> >                                          (cleanup))
> >                                      ;; clean up...
> >                                      )))
> >
> > There's a race here in case multiple threads try to change the cleanup
> > procedure associated with that particular thread at the same time, but I
> > suppose it is not an issue in practice.
>
> Fair enough, re: closures.  But why should callers outside the current
> thread be able to access that thread's cleanup handler procedure?
> Maybe this isn't a realistic issue, but you could use this to "inject"
> arbitrary code into a separate thread by setting the cleanup procedure
> and immediately canceling the thread.  Why not treat the handler as
> thread-specific data?


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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi,

"Julian Graham" <joolean@gmail.com> writes:

> Fair enough, re: closures.  But why should callers outside the current
> thread be able to access that thread's cleanup handler procedure?
> Maybe this isn't a realistic issue, but you could use this to "inject"
> arbitrary code into a separate thread by setting the cleanup procedure
> and immediately canceling the thread.  Why not treat the handler as
> thread-specific data?

Anyway, as long as you have a reference to an object (including a thread
object), you can use the relevant procedures to mutate it.  For
instance, if my code passes a list to yours, I have no guarantee that
your code won't call `set-car!' on it.

Just to say that hiding the data doesn't solve this authorization
problem, it just makes it less visible.

Beside, it may be useful in some cases to assign a thread finalizer from
outside the thread itself.

Thanks,
Ludovic.


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

Re: thread cancellation, take 2

[Julian Graham]

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

On 9/26/07, Ludovic Courtès <ludovic.courtes@laas.fr> wrote:

> Anyway, as long as you have a reference to an object (including a thread
> object), you can use the relevant procedures to mutate it.  For
> instance, if my code passes a list to yours, I have no guarantee that
> your code won't call `set-car!' on it.
>
> Just to say that hiding the data doesn't solve this authorization
> problem, it just makes it less visible.
>
> Beside, it may be useful in some cases to assign a thread finalizer from
> outside the thread itself.

Okay.  Here's the latest revision of the patch:

* Changed the API as Ludovic suggests above -- push-thread-cleanup and
pop-thread-cleanup are now, respectively, set-thread-cleanup! and
thread-cleanup, and you can set and get to / from whatever thread you
want.

* Updated threads.test.

* Modified the behavior of cancel-thread to allow for canceling the
current thread.  This necessitated some changes to scmsigs, so that
the signal delivery thread could be notified to shut down -- not
cleanly closing the signal pipe was leaving the process in a zombie
state -- specifically, the addition of an extra mutex and a function
in scmsigs.c. Let me know if this is too sloppy; rationale is provided
in the comments.

* Also (I realize this is a bit unrelated) changed the behavior of
all-threads so that it doesn't include the signal delivery thread,
because nobody has any business messing with it. Exposed a pointer to
the delivery thread from of scmsigs.o. I hope this isn't too sloppy,
either.


Regards,
Julian

[-- 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: 12837 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	27 Sep 2007 02:20:32 -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.15
diff -a -u -r1.15 pthread-threads.h
--- libguile/pthread-threads.h	9 Oct 2006 23:21:00 -0000	1.15
+++ libguile/pthread-threads.h	27 Sep 2007 02:20:32 -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	27 Sep 2007 02:20:33 -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,20 +189,25 @@
 	  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
@@ -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	27 Sep 2007 02:20:33 -0000
@@ -41,6 +41,8 @@
 SCM_API SCM scm_raise (SCM sig);
 SCM_API void scm_init_scmsigs (void);
 
+SCM_API void scm_i_close_signal_pipe (void);
+
 #endif  /* SCM_SCMSIGS_H */
 
 /*
Index: libguile/threads.c
===================================================================
RCS file: /sources/guile/guile/guile-core/libguile/threads.c,v
retrieving revision 1.88
diff -a -u -r1.88 threads.c
--- libguile/threads.c	15 Jan 2007 23:35:34 -0000	1.88
+++ libguile/threads.c	27 Sep 2007 02:20:34 -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;
 }
 
@@ -517,6 +533,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);
@@ -882,6 +909,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} "
@@ -1539,8 +1634,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;
@@ -1694,6 +1792,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	27 Sep 2007 02:20:34 -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	27 Sep 2007 02:20:35 -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

Re: thread cancellation, take 2

[Julian Graham]

[-- 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

Re: thread cancellation, take 2

[Ludovic Courtès]

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

Hi Julian,

I went through your patch again and installed a slightly modified
version, mostly formatting issues (attached).  I guess you're now more
familiar than I am with specific pthread issues, so I could have missed
a few points.

You changed `all-threads' so that it hides the signal-delivery thread.
It seems harmless and reasonable, so I installed it too.  If others can
think of reasons not to do it, please speak up.

Thanks!

Ludovic.


[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 18495 bytes --]

--- orig/ChangeLog
+++ mod/ChangeLog
@@ -1,3 +1,7 @@
+2007-10-20  Julian Graham  <joolean@gmail.com>
+
+	* NEWS: Mention thread cancellation and cleanup API.
+
 2007-10-17  Ludovic Courtès  <ludo@gnu.org>
 
 	* NEWS: Mention reader bug-fix.
--- orig/NEWS
+++ mod/NEWS
@@ -26,6 +26,9 @@ be used for efficiently implementing a S
 ** Duplicate bindings among used modules are resolved lazily.
 This slightly improves program startup times.
 
+** New thread cancellation and thread cleanup API
+See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'.
+
 * Changes to the C interface
 
 ** Functions for handling `scm_option' now no longer require an argument
--- orig/libguile/ChangeLog
+++ mod/libguile/ChangeLog
@@ -1,3 +1,42 @@
+2007-10-20  Julian Graham  <joolean@gmail.com>
+
+	Add support for thread cancellation and user-defined thread
+	cleanup handlers.  Small rework by Ludovic Courtès.
+
+	* null-threads.h (scm_i_pthread_cancel,
+	scm_i_pthread_cleanup_push, scm_i_pthread_cleanup_pop): New.
+	* pthread-threads.h (scm_i_pthread_cancel,
+	scm_i_pthread_cleanup_push, scm_i_pthread_cleanup_pop): New.
+	* scmsigs.c (scm_i_signal_delivery_thread,
+	signal_delivery_thread_mutex): New.
+	(signal_delivery_thread): Leave when `read_without_guile ()'
+	returns zero.
+	(start_signal_delivery_thread): Acquire SIGNAL_DELIVERY_THREAD
+	before spawning the thread.  Initialize
+	SCM_I_SIGNAL_DELIVERY_THREAD.
+	(ensure_signal_delivery_thread): Renamed to...
+	(scm_i_ensure_signal_delivery_thread): this.
+	(scm_i_close_signal_pipe): New.
+	* scmsigs.h: Updated.
+	* threads.c (thread_mark): Mark `t->cleanup_handler'.
+	(guilify_self_1): Initialize `t->cleanup_handler' and
+	`t->canceled'.
+	(do_thread_exit): Invoke `t->cleanup_handler'.
+	(on_thread_exit): Call `scm_i_ensure_signal_delivery_thread ()'.
+	Call `scm_i_close_signal_pipe ()' when the next-to-last thread
+	vanishes.
+	(scm_leave_guile_cleanup): New.
+	(scm_i_with_guile_and_parent): Use `scm_i_pthread_cleanup_push ()' 
+	and `scm_leave_guile_cleanup ()' to leave guile mode, rather
+	than call `scm_leave_guile ()' after FUNC.
+	(scm_cancel_thread, scm_set_thread_cleanup_x,
+	scm_threads_cleanup): New.
+	(scm_all_threads): Remove SCM_I_SIGNAL_DELIVERY_THREAD from the
+	returned list.
+	* threads.h (scm_i_thread)[cleanup_handler, canceled]: New
+	fields.
+	Add declarations of new functions.
+	
 2007-10-17  Ludovic Courtès  <ludo@gnu.org>
 
 	* read.c (CHAR_IS_BLANK_): Add `\r' (ASCII 0x0d).  This fixes a
--- orig/libguile/null-threads.h
+++ mod/libguile/null-threads.h
@@ -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
--- orig/libguile/pthread-threads.h
+++ mod/libguile/pthread-threads.h
@@ -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
--- orig/libguile/scmsigs.c
+++ mod/libguile/scmsigs.c
@@ -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,14 @@ static SCM *signal_handlers;
 static SCM signal_handler_asyncs;
 static SCM signal_handler_threads;
 
+/* The signal delivery thread.  */
+scm_i_thread *scm_i_signal_delivery_thread = NULL;
+
+/* The mutex held when launching the signal delivery thread.  */
+static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
+  SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
+
 /* 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 +194,34 @@ signal_delivery_thread (void *data)
 	  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 signal_thread;
+
+  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");
+  signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
+				    scm_handle_by_message,
+				    "signal delivery thread");
+  scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_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 +247,8 @@ take_signal (int signum)
 #endif
 }
 
-static void
-ensure_signal_delivery_thread ()
+void
+scm_i_ensure_signal_delivery_thread ()
 {
   return;
 }
@@ -332,7 +351,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "s
 	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,6 +672,21 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 \f
 
 void
+scm_i_close_signal_pipe()
+{
+  /* SIGNAL_DELIVERY_THREAD_MUTEX is only 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;
--- orig/libguile/scmsigs.h
+++ mod/libguile/scmsigs.h
@@ -3,7 +3,7 @@
 #ifndef SCM_SCMSIGS_H
 #define SCM_SCMSIGS_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,7 @@
 \f
 
 #include "libguile/__scm.h"
+#include "libguile/threads.h"
 
 \f
 
@@ -41,6 +42,11 @@ SCM_API SCM scm_usleep (SCM i);
 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);
+
+SCM_API scm_i_thread *scm_i_signal_delivery_thread;
+
 #endif  /* SCM_SCMSIGS_H */
 
 /*
--- orig/libguile/threads.c
+++ mod/libguile/threads.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -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 @@ thread_mark (SCM obj)
 {
   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);
@@ -415,6 +417,7 @@ guilify_self_1 (SCM_STACKITEM *base)
   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 +437,7 @@ guilify_self_1 (SCM_STACKITEM *base)
   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 +482,17 @@ guilify_self_2 (SCM parent)
 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 +503,7 @@ do_thread_exit (void *v)
     ;
 
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
   return NULL;
 }
 
@@ -496,10 +511,14 @@ static void
 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 +534,14 @@ on_thread_exit (void *v)
 	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 +711,30 @@ scm_with_guile (void *(*func)(void *), v
 				      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 +920,74 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
 }
 #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_false (proc))
+    SCM_VALIDATE_THUNK (2, proc);
+
+  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_thread_cleanup, "thread-cleanup", 1, 0, 0,
+	    (SCM thread),
+"Return the cleanup handler installed for the thread @var{thread}.")
+#define FUNC_NAME s_scm_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} "
@@ -891,7 +999,7 @@ SCM_DEFINE (scm_join_thread, "join-threa
 
   SCM_VALIDATE_THREAD (1, thread);
   if (scm_is_eq (scm_current_thread (), thread))
-    SCM_MISC_ERROR ("can not join the current thread", SCM_EOL);
+    SCM_MISC_ERROR ("cannot join the current thread", SCM_EOL);
 
   scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
 
@@ -911,10 +1019,13 @@ SCM_DEFINE (scm_join_thread, "join-threa
   res = t->result;
 
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
   return res;
 }
 #undef FUNC_NAME
 
+
+\f
 /*** Fat mutexes */
 
 /* We implement our own mutex type since we want them to be 'fair', we
@@ -1537,8 +1648,11 @@ SCM_DEFINE (scm_all_threads, "all-thread
   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;
--- orig/libguile/threads.h
+++ mod/libguile/threads.h
@@ -3,7 +3,7 @@
 #ifndef SCM_THREADS_H
 #define SCM_THREADS_H
 
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -49,9 +49,11 @@ typedef struct scm_i_thread {
 
   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 @@ do { \
 
 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_thread_cleanup (SCM thread);
 SCM_API SCM scm_join_thread (SCM t);
 
 SCM_API SCM scm_make_mutex (void);
--- orig/test-suite/ChangeLog
+++ mod/test-suite/ChangeLog
@@ -1,3 +1,10 @@
+2007-10-20  Julian Graham  <joolean@gmail.com>
+
+	* tests/threads.test: Use proper `define-module'.
+	(cancel-thread, handler result passed to join, can cancel self,
+	handler supplants final expr, remove handler by setting false,
+	initial handler is false): New tests.
+
 2007-10-17  Ludovic Courtès  <ludo@gnu.org>
 
 	* tests/reader.test (reading)[CR recognized as a token
--- orig/test-suite/tests/threads.test
+++ mod/test-suite/tests/threads.test
@@ -1,6 +1,6 @@
 ;;;; threads.test --- Tests for Guile threading.    -*- scheme -*-
 ;;;;
-;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -17,8 +17,10 @@
 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;;;; Boston, MA 02110-1301 USA
 
-(use-modules (ice-9 threads)
-	     (test-suite lib))
+(define-module (test-threads)
+  :use-module (ice-9 threads)
+  :use-module (test-suite lib))
+
 
 (if (provided? 'threads)
     (begin
@@ -133,4 +135,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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hey,

BTW, could you also provide a patch to update the documentation?

Thanks in advance,  :-)
Ludovic.



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

Re: thread cancellation, take 2

[Julian Graham]

Hi Ludovic,

> BTW, could you also provide a patch to update the documentation?

I'd be happy to -- I assume you're talking about stuff that's
currently missing, like documentation for the condition variable
functions?


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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi Julian,

"Julian Graham" <joolean@gmail.com> writes:

> I'd be happy to -- I assume you're talking about stuff that's
> currently missing, like documentation for the condition variable
> functions?

Indeed, I hadn't realized the documentation lacked this.  Initially, I
was referring to the new procedures you added, but adding condition
variables, mutexes and friends would be nice too.

Thanks,
Ludovic.



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

Re: thread cancellation, take 2

[Ludovic Courtès]

ludo@gnu.org (Ludovic Courtès) writes:

> Indeed, I hadn't realized the documentation lacked this.  Initially, I
> was referring to the new procedures you added, but adding condition
> variables, mutexes and friends would be nice too.

Actually, condition variables and mutexes seem to be fairly well
documented, or did I miss something else?  :-)

Thanks,
Ludovic.



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

Re: thread cancellation, take 2

[Julian Graham]

> Actually, condition variables and mutexes seem to be fairly well
> documented, or did I miss something else?  :-)


Oops, for some reason I was looking at the 1.6.8 manual (blame it on
the cold I've had for the past few days).  I'll have some docs in
shortly.


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

Re: thread cancellation, take 2

[Julian Graham]

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

Find attached a patch that adds documentation for the thread
cancellation functions.  Let me know if I should change anything.


On 10/23/07, Julian Graham <joolean@gmail.com> wrote:
> > Actually, condition variables and mutexes seem to be fairly well
> > documented, or did I miss something else?  :-)
>
>
> Oops, for some reason I was looking at the 1.6.8 manual (blame it on
> the cold I've had for the past few days).  I'll have some docs in
> shortly.
>

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

Index: api-scheduling.texi
===================================================================
RCS file: /sources/guile/guile/guile-core/doc/ref/api-scheduling.texi,v
retrieving revision 1.17
diff -a -u -r1.17 api-scheduling.texi
--- api-scheduling.texi	17 Jun 2006 23:15:22 -0000	1.17
+++ api-scheduling.texi	24 Oct 2007 02:29:46 -0000
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -285,6 +285,42 @@
 immediate context switch to one of them. Otherwise, yield has no effect.
 @end deffn
 
+@deffn {Scheme Procedure} cancel-thread thread
+@deffnx {C Function} scm_cancel_thread (thread)
+Asynchronously notify @code{thread} to exit. Immediately after receiving
+this notification, @code{thread} will call its cleanup handler (if one
+has been set) and then terminate, aborting any evaluation that is in
+progress.
+
+Because Guile threads are isomorphic with POSIX threads, @code{thread}
+will not receive its cancellation signal until it reaches a cancellation
+point. See your operating system's POSIX threading documentation for 
+more information on cancellation points; note that in Guile, unlike 
+native POSIX threads, a thread can receive a cancellation notification 
+while attempting to lock a mutex. 
+@end deffn
+
+@deffn {Scheme Procedure} set-thread-cleanup! thread proc
+@deffnx {C Function} scm_set_thread_cleanup_x (thread, proc)
+Set @code{proc} as the cleanup handler for the thread @code{thread}.
+@code{proc}, which must be a thunk, will be called when @code{thread} 
+exits, either normally or by being canceled. Thread cleanup handlers
+can be used to perform useful tasks like releasing resources, such as
+locked mutexes, when thread exit cannot be predicted.
+
+The return value of @var{proc} will be set as the @emph{exit value} of
+@code{thread}.
+
+To remove a cleanup handler, pass @code{#f} for @code{proc}.
+@end deffn
+
+@deffn {Scheme Procedure} thread-cleanup thread
+@deffnx {C Function} scm_thread_cleanup (thread)
+Return the cleanup handler currently installed for the thread 
+@code{thread}. If no cleanup handler is currently installed, 
+thread-cleanup returns @code{#f}.
+@end deffn
+
 Higher level thread procedures are available by loading the
 @code{(ice-9 threads)} module.  These provide standardized
 thread creation.

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

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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi Julian,

"Julian Graham" <joolean@gmail.com> writes:

> Find attached a patch that adds documentation for the thread
> cancellation functions.  Let me know if I should change anything.

Great, I just installed it.

A couple of nitpicks:

  - Make sure to use `@var', not `@code', for variables.

  - Leave two spaces after periods that end sentences.

(See the GNU Coding Standards for more nitpicking.  ;-))

Thanks!

Ludo'.



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

Re: thread cancellation, take 2

[Julian Graham]

Re: @var, @code, of course, my mistake.

As for the spaces thing, both my parents are copy editors and I was
raised to use the double space.  But my girlfriend is also a copy
editor (for newer, fancier magazines) and she assures me that the
double space is a thing of the past.  So my divergence from Guile's
documentation style demonstrates... well, I don't know what it
demonstrates, but I'll keep an eye on it for future submissions.  ;)

Thanks!


On 10/29/07, Ludovic Courtès <ludo@gnu.org> wrote:
> Hi Julian,
>
> "Julian Graham" <joolean@gmail.com> writes:
>
> > Find attached a patch that adds documentation for the thread
> > cancellation functions.  Let me know if I should change anything.
>
> Great, I just installed it.
>
> A couple of nitpicks:
>
>   - Make sure to use `@var', not `@code', for variables.
>
>   - Leave two spaces after periods that end sentences.
>
> (See the GNU Coding Standards for more nitpicking.  ;-))
>
> Thanks!
>
> Ludo'.
>
>
>
> _______________________________________________
> Guile-devel mailing list
> Guile-devel@gnu.org
> http://lists.gnu.org/mailman/listinfo/guile-devel
>


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

Re: thread cancellation, take 2

[Neil Jerram]

"Julian Graham" <joolean@gmail.com> writes:

> Re: @var, @code, of course, my mistake.
>
> As for the spaces thing, both my parents are copy editors and I was
> raised to use the double space.  But my girlfriend is also a copy
> editor (for newer, fancier magazines) and she assures me that the
> double space is a thing of the past.

But that could mean many things.  For example, TeX doesn't care how
many spaces you type in the source file; it will typeset the correct
end-of-sentence-size space anyway.

My understanding is that the two space convention is for fixed-width
computer presentation, such as in Info.  Many people seem to think
that two spaces look better in that context.

(Personally I always notice how browser-rendered text looks wrong in
this respect - because HTML (like TeX) doesn't care how many spaces
there are in the source, but the browsers (unlike TeX) don't leave a
little extra width at the end of a sentence.)

Regards,
      Neil



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

Re: thread cancellation, take 2

[Ludovic Courtès]

Hi,

Neil Jerram <neil@ossau.uklinux.net> writes:

> My understanding is that the two space convention is for fixed-width
> computer presentation, such as in Info.  Many people seem to think
> that two spaces look better in that context.

That's my understanding, too.  It also helps differentiate periods that
denote an abbreviation from periods at the end of sentences.  Overall, I
find it easier to read.

Thanks,
Ludovic.


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