[Guile-commits] 17/17: Remove thread cleanup facility

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit eeeee3297b8d4cb0717ee3b9ae5068b4f0b7f118
Author: Andy Wingo <address@hidden>
Date:   Mon Oct 31 22:37:46 2016 +0100

    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                          |    6 ++++
 doc/ref/api-scheduling.texi   |   21 --------------
 libguile/threads.c            |   61 -----------------------------------------
 libguile/threads.h            |    3 --
 module/ice-9/deprecated.scm   |    2 --
 module/ice-9/threads.scm      |    2 --
 test-suite/tests/threads.test |   29 +++-----------------
 7 files changed, 10 insertions(+), 114 deletions(-)

diff --git a/NEWS b/NEWS
index 06f2e8c..a5b1a01 100644
--- a/NEWS
+++ b/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
 
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index 564d43f..6e9b5b1 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -125,27 +125,6 @@ Under this hood, thread cancellation uses 
@code{system-async-mark} and
 interrupts.
 @end deffn
 
address@hidden {Scheme Procedure} set-thread-cleanup! thread proc
address@hidden {C Function} scm_set_thread_cleanup_x (thread, proc)
-Set @var{proc} as the cleanup handler for the thread @var{thread}.
address@hidden, 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
address@hidden
-
-To remove a cleanup handler, pass @code{#f} for @var{proc}.
address@hidden deffn
-
address@hidden {Scheme Procedure} thread-cleanup thread
address@hidden {C Function} scm_thread_cleanup (thread)
-Return the cleanup handler currently installed for the thread
address@hidden  If no cleanup handler is currently installed,
-thread-cleanup returns @code{#f}.
address@hidden 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
diff --git a/libguile/threads.c b/libguile/threads.c
index 8ac0832..37381cb 100644
--- a/libguile/threads.c
+++ b/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);
diff --git a/libguile/threads.h b/libguile/threads.h
index 90bb661..b7f0fd9 100644
--- a/libguile/threads.h
+++ b/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);
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index de917df..52b3d63 100644
--- a/module/ice-9/deprecated.scm
+++ b/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
diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm
index 5871e9a..555143e 100644
--- a/module/ice-9/threads.scm
+++ b/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
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index 3b7a3e4..f489d59 100644
--- a/test-suite/tests/threads.test
+++ b/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)
+             (cancel-thread t 'foo)
              (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)
-                                                         (lambda () 'foo))
-                                    (cancel-thread (current-thread))
+                                    (cancel-thread (current-thread) 'foo)
                                     (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)))))
+             (eq? (join-thread t) 'foo)))))
 
       ;;
       ;; mutex ownership