[Guile-commits] 15/17: srfi-18: thread-terminate! without cleanup handlers

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit b85f033526c77c89c38a0cdcc156b18a9784bb09
Author: Andy Wingo <address@hidden>
Date:   Mon Oct 31 22:11:43 2016 +0100

    srfi-18: thread-terminate! without cleanup handlers
    
    * module/srfi/srfi-18.scm (%cancel-sentinel, thread-terminate!): Just
      use cancel-thread to cause the thread to return a sentinel value.
      (%timeout-sentinel): Rename from %sentinel.
      (thread-join!): Adapt and transform %cancel-sentinel to a
      &terminated-thread-exception.
---
 module/srfi/srfi-18.scm |   36 +++++++++++++-----------------------
 1 file changed, 13 insertions(+), 23 deletions(-)

diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index fe5e764..36b19e7 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -232,38 +232,28 @@
       (lambda (k exn)
         ((current-exception-handler) exn)))))
 
-;; A pass-thru to cancel-thread that first installs a handler that throws
-;; terminated-thread exception, as per SRFI-18, 
-
+;; A unique value.
+(define %cancel-sentinel (list 'cancelled))
 (define (thread-terminate! thread)
-  (let ((current-handler (threads:thread-cleanup thread)))
-    (threads:set-thread-cleanup!
-     thread
-     (let ((handler (lambda ()
-                      (set! (thread->exception (threads:current-thread))
-                        (condition (&terminated-thread-exception))))))
-       (if (thunk? current-handler)
-           (lambda ()
-             (current-handler)
-             (handler))
-           handler)))
-    (threads:cancel-thread thread)
-    *unspecified*))
+  (threads:cancel-thread thread %cancel-sentinel)
+  *unspecified*)
 
 ;; A unique value.
-(define %sentinel (list 1))
-(define* (thread-join! thread #:optional (timeout %sentinel)
-                       (timeoutval %sentinel))
+(define %timeout-sentinel (list 1))
+(define* (thread-join! thread #:optional (timeout %timeout-sentinel)
+                       (timeoutval %timeout-sentinel))
   (with-exception-handlers-here
    (lambda ()
-     (let ((v (if (eq? timeout %sentinel)
+     (let ((v (if (eq? timeout %timeout-sentinel)
                   (threads:join-thread thread)
-                  (threads:join-thread thread timeout %sentinel))))
+                  (threads:join-thread thread timeout %timeout-sentinel))))
        (cond
-        ((eq? v %sentinel)
-         (if (eq? timeoutval %sentinel)
+        ((eq? v %timeout-sentinel)
+         (if (eq? timeoutval %timeout-sentinel)
              (srfi-34:raise (condition (&join-timeout-exception)))
              timeoutval))
+        ((eq? v %cancel-sentinel)
+         (srfi-34:raise (condition (&terminated-thread-exception))))
         ((thread->exception thread) => srfi-34:raise)
         (else v))))))