Remove thread cleanup facility

* NEWS: Add entry.
* doc/ref/api-scheduling.texi (Threads): Remove thread-cleanup docs.
* libguile/threads.c (guilify_self_1, do_thread_exit):
  (scm_set_thread_cleanup_x, scm_thread_cleanup): Remove these.
* libguile/threads.h (scm_i_thread): Remove cleanup_handler.
* module/ice-9/threads.scm:
* module/ice-9/deprecated.scm (thread-cleanup, set-thread-cleanup!):
  Remove.
* test-suite/tests/threads.test: Adapt to test cancel-thread return
  values and not test thread-cleanup procs.

NEWS

@@ -21,6 +21,12 @@ break, however; we used the deprecation facility to signal a warning
 message while also providing these bindings in the root environment for
 the duration of the 2.2 series.
 
+** Thread cleanup handlers removed
+
+The `set-thread-cleanup!' and `thread-cleanup' functions that were added
+in Guile 2.0 to support cleanup after thread cancellation are no longer
+needed, since threads can declare cleanup handlers via `dynamic-wind'.
+
 * New deprecations
 ** Arbiters deprecated
 

doc/ref/api-scheduling.texi

@@ -125,27 +125,6 @@ Under this hood, thread cancellation uses @code{system-async-mark} and
 interrupts.
 @end deffn
 
-@deffn {Scheme Procedure} set-thread-cleanup! thread proc
-@deffnx {C Function} scm_set_thread_cleanup_x (thread, proc)
-Set @var{proc} as the cleanup handler for the thread @var{thread}.
-@var{proc}, which must be a thunk, will be called when @var{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
-@var{thread}.
-
-To remove a cleanup handler, pass @code{#f} for @var{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
-@var{thread}.  If no cleanup handler is currently installed,
-thread-cleanup returns @code{#f}.
-@end deffn
-
 @deffn macro make-thread proc arg @dots{}
 Apply @var{proc} to @var{arg} @dots{} in a new thread formed by
 @code{call-with-new-thread} using a default error handler that display

libguile/threads.c

@@ -408,7 +408,6 @@ guilify_self_1 (struct GC_stack_base *base)
   t.pthread = scm_i_pthread_self ();
   t.handle = SCM_BOOL_F;
   t.result = SCM_BOOL_F;
-  t.cleanup_handler = SCM_BOOL_F;
   t.mutexes = SCM_EOL;
   t.held_mutex = NULL;
   t.join_queue = SCM_EOL;
@@ -527,13 +526,6 @@ typedef struct {
 #define SCM_MUTEXP(x)         SCM_SMOB_PREDICATE (scm_tc16_mutex, x)
 #define SCM_MUTEX_DATA(x)     ((fat_mutex *) SCM_SMOB_DATA (x))
 
-static SCM
-call_cleanup (void *data)
-{
-  SCM *proc_p = data;
-  return scm_call_0 (*proc_p);
-}
-  
 /* Perform thread tear-down, in guile mode.
  */
 static void *
@@ -541,16 +533,6 @@ do_thread_exit (void *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,
-				      call_cleanup, &ptr,
-				      scm_handle_by_message_noexit, NULL);
-    }
-
   scm_i_scm_pthread_mutex_lock (&t->admin_mutex);
 
   t->exited = 1;
@@ -1020,49 +1002,6 @@ scm_cancel_thread (SCM thread)
   return SCM_UNSPECIFIED;
 }
 
-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);
-
-  t = SCM_I_THREAD_DATA (thread);
-  scm_i_pthread_mutex_lock (&t->admin_mutex);
-
-  if (!t->exited)
-    t->cleanup_handler = proc;
-
-  scm_i_pthread_mutex_unlock (&t->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);
-
-  t = SCM_I_THREAD_DATA (thread);
-  scm_i_pthread_mutex_lock (&t->admin_mutex);
-  ret = t->exited ? SCM_BOOL_F : t->cleanup_handler;
-  scm_i_pthread_mutex_unlock (&t->admin_mutex);
-
-  return ret;
-}
-#undef FUNC_NAME
-
 SCM scm_join_thread (SCM thread)
 {
   return scm_join_thread_timed (thread, SCM_UNDEFINED, SCM_UNDEFINED);

libguile/threads.h

@@ -60,7 +60,6 @@ typedef struct scm_i_thread {
   SCM handle;
   scm_i_pthread_t pthread;
 
-  SCM cleanup_handler;
   SCM join_queue;
 
   scm_i_pthread_mutex_t admin_mutex;
@@ -151,8 +150,6 @@ SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_block_asyncs (scm_i_pthread_m
 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_join_thread_timed (SCM t, SCM timeout, SCM timeoutval);
 SCM_API SCM scm_thread_p (SCM t);

module/ice-9/deprecated.scm

@@ -57,8 +57,6 @@
   call-with-new-thread
   yield
   cancel-thread
-  set-thread-cleanup!
-  thread-cleanup
   join-thread
   thread?
   make-mutex

module/ice-9/threads.scm

@@ -41,8 +41,6 @@
   #:replace (call-with-new-thread
              yield
              cancel-thread
-             set-thread-cleanup!
-             thread-cleanup
              join-thread
              thread?
              make-mutex

test-suite/tests/threads.test

@@ -351,13 +351,12 @@
 	      (join-thread t)
 	      #t)))
 
-	(pass-if "handler result passed to join"
+	(pass-if "cancel result passed to join"
           (require-cancel-thread)
 	  (let ((m (make-mutex)))
 	    (lock-mutex m)
 	    (let ((t (begin-thread (lock-mutex m))))
-	      (set-thread-cleanup! t (lambda () 'foo))
+	      (cancel-thread t 'foo)
-	      (cancel-thread t)
 	      (eq? (join-thread t) 'foo))))
 
 	(pass-if "can cancel self"
@@ -365,29 +364,9 @@
 	  (let ((m (make-mutex)))
 	    (lock-mutex m)
 	    (let ((t (begin-thread (begin
-				     (set-thread-cleanup! (current-thread)
+				     (cancel-thread (current-thread) 'foo)
-							  (lambda () 'foo))
-				     (cancel-thread (current-thread))
 				     (lock-mutex m)))))
-	      (eq? (join-thread t) 'foo))))
+	      (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)))))
 
       ;;
       ;; mutex ownership