diff options
author | Andy Wingo <wingo@pobox.com> | 2016-11-05 00:13:55 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-11-05 00:13:55 +0100 |
commit | c6a8092b3f0fd3511a540174a1b7f1b46234118b (patch) | |
tree | fefdbfe4b1d6049525fdafcc222852d56a83fceb | |
parent | ecfa0b50cec560ecd960d602d99b7443b07dffc2 (diff) | |
download | guile-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.scm | 41 |
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 |