diff --git a/basis/concurrency/locks/locks-tests.factor b/basis/concurrency/locks/locks-tests.factor index 92dede1655..67f9bbb15a 100755 --- a/basis/concurrency/locks/locks-tests.factor +++ b/basis/concurrency/locks/locks-tests.factor @@ -174,7 +174,7 @@ threads sequences calendar accessors ; ] ; [ lock-timeout-test ] [ - linked-error-thread name>> "Lock timeout-er" = + thread>> name>> "Lock timeout-er" = ] must-fail-with :: read/write-test ( -- ) diff --git a/basis/concurrency/locks/locks.factor b/basis/concurrency/locks/locks.factor index 95b6801db2..8c1392dbfb 100755 --- a/basis/concurrency/locks/locks.factor +++ b/basis/concurrency/locks/locks.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: deques dlists kernel threads continuations math -concurrency.conditions ; +concurrency.conditions combinators.short-circuit accessors ; IN: concurrency.locks ! Simple critical sections @@ -16,13 +16,13 @@ TUPLE: lock threads owner reentrant? ; r lock-threads r> "lock" wait ] when drop - self swap set-lock-owner ; + over owner>> + [ 2dup >r threads>> r> "lock" wait ] when drop + self >>owner drop ; : release-lock ( lock -- ) - f over set-lock-owner - lock-threads notify-1 ; + f >>owner + threads>> notify-1 ; : do-lock ( lock timeout quot acquire release -- ) >r >r pick rot r> call ! use up timeout acquire @@ -34,8 +34,8 @@ TUPLE: lock threads owner reentrant? ; PRIVATE> : with-lock-timeout ( lock timeout quot -- ) - pick lock-reentrant? [ - pick lock-owner self eq? [ + pick reentrant?>> [ + pick owner>> self eq? [ 2nip call ] [ (with-lock) @@ -56,44 +56,43 @@ TUPLE: rw-lock readers writers reader# writer ; r rw-lock-readers r> "read lock" wait ] when drop + over writer>> + [ 2dup >r readers>> r> "read lock" wait ] when drop add-reader ; : notify-writer ( lock -- ) - rw-lock-writers notify-1 ; + writers>> notify-1 ; : remove-reader ( lock -- ) - dup rw-lock-reader# 1- swap set-rw-lock-reader# ; + [ 1- ] change-reader# drop ; : release-read-lock ( lock -- ) dup remove-reader - dup rw-lock-reader# zero? [ notify-writer ] [ drop ] if ; + dup reader#>> zero? [ notify-writer ] [ drop ] if ; : acquire-write-lock ( lock timeout -- ) - over rw-lock-writer pick rw-lock-reader# 0 > or - [ 2dup >r rw-lock-writers r> "write lock" wait ] when drop - self swap set-rw-lock-writer ; + over writer>> pick reader#>> 0 > or + [ 2dup >r writers>> r> "write lock" wait ] when drop + self >>writer drop ; : release-write-lock ( lock -- ) - f over set-rw-lock-writer - dup rw-lock-readers deque-empty? - [ notify-writer ] [ rw-lock-readers notify-all ] if ; + f >>writer + dup readers>> deque-empty? + [ notify-writer ] [ readers>> notify-all ] if ; : reentrant-read-lock-ok? ( lock -- ? ) #! If we already have a write lock, then we can grab a read #! lock too. - rw-lock-writer self eq? ; + writer>> self eq? ; : reentrant-write-lock-ok? ( lock -- ? ) #! The only case where we have a writer and > 1 reader is #! write -> read re-entrancy, and in this case we prohibit #! a further write -> read -> write re-entrancy. - dup rw-lock-writer self eq? - swap rw-lock-reader# zero? and ; + { [ writer>> self eq? ] [ reader#>> zero? ] } 1&& ; PRIVATE>