steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

new accessors

db4
Doug Coleman 2008-08-30 21:19:06 -05:00
parent a97619b747
commit 98c2548fa3
2 changed files with 23 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/concurrency/locks/locks-tests.factor
View File

@ -174,7 +174,7 @@ threads sequences calendar accessors ;
] ; ] ;
[ lock-timeout-test ] [ [ lock-timeout-test ] [
linked-error-thread name>> "Lock timeout-er" = thread>> name>> "Lock timeout-er" =
] must-fail-with ] must-fail-with
:: read/write-test ( -- ) :: read/write-test ( -- )

45
basis/concurrency/locks/locks.factor
View File

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