summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-11-05 00:13:55 +0100
committerAndy Wingo <wingo@pobox.com>2016-11-05 00:13:55 +0100
commitc6a8092b3f0fd3511a540174a1b7f1b46234118b (patch)
treefefdbfe4b1d6049525fdafcc222852d56a83fceb
parentecfa0b50cec560ecd960d602d99b7443b07dffc2 (diff)
downloadguile-c6a8092b3f0fd3511a540174a1b7f1b46234118b.tar.gz
SRFI-18 manages own mutex "abandoned" state
* module/srfi/srfi-18.scm (<mutex>, with-thread-mutex-cleanup) (make-mutex, mutex-state, abandon-mutex!, mutex-lock!): Manage "abandoned" bit on Scheme side with no need for thread cleanup handler.
-rw-r--r--module/srfi/srfi-18.scm41
1 files changed, 20 insertions, 21 deletions
diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index d3a6a0909..a19d5ba63 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -112,12 +112,13 @@
(reason uncaught-exception-reason))
(define-record-type <mutex>
- (%make-mutex prim name specific owner)
+ (%make-mutex prim name specific owner abandoned?)
mutex?
(prim mutex-prim)
(name mutex-name)
(specific mutex-specific mutex-specific-set!)
- (owner mutex-owner set-mutex-owner!))
+ (owner mutex-owner set-mutex-owner!)
+ (abandoned? mutex-abandoned? set-mutex-abandoned?!))
(define-record-type <condition-variable>
(%make-condition-variable prim name specific)
@@ -179,7 +180,7 @@
(lambda ()
(let ((thread (current-thread)))
(hash-for-each (lambda (mutex _)
- (when (eq? (mutex-state mutex) thread)
+ (when (eq? (mutex-owner mutex) thread)
(abandon-mutex! mutex)))
mutexes))))))
@@ -293,19 +294,19 @@
'recursive)
name
#f
+ #f
#f))
(define (mutex-state mutex)
- (let* ((prim (mutex-prim mutex))
- (owner (mutex-owner mutex)))
- (if owner
- (if (and=> (thread-prim owner) threads:thread-exited?)
- 'abandoned
- owner)
- (if (> (threads:mutex-level prim) 0) 'not-owned 'not-abandoned))))
+ (cond
+ ((mutex-abandoned? mutex) 'abandoned)
+ ((mutex-owner mutex))
+ ((> (threads:mutex-level (mutex-prim mutex)) 0) 'not-owned)
+ (else 'not-abandoned)))
(define (abandon-mutex! mutex)
- #t)
+ (set-mutex-abandoned?! mutex #t)
+ (threads:unlock-mutex (mutex-prim mutex)))
(define* (mutex-lock! mutex #:optional timeout (thread (current-thread)))
(let ((mutexes (thread-mutexes)))
@@ -313,17 +314,15 @@
(hashq-set! mutexes mutex #t)))
(with-exception-handlers-here
(lambda ()
- (catch 'abandoned-mutex-error
- (lambda ()
- (cond
- ((threads:lock-mutex (mutex-prim mutex) timeout)
- (set-mutex-owner! mutex thread)
- #t)
- (else #f)))
- (lambda (key . args)
- (set-mutex-owner! mutex thread)
+ (cond
+ ((threads:lock-mutex (mutex-prim mutex) timeout)
+ (set-mutex-owner! mutex thread)
+ (when (mutex-abandoned? mutex)
+ (set-mutex-abandoned?! mutex #f)
(srfi-34:raise
- (condition (&abandoned-mutex-exception))))))))
+ (condition (&abandoned-mutex-exception))))
+ #t)
+ (else #f)))))
(define mutex-unlock!
(case-lambda