1 ! Copyright (C) 2008 Slava Pestov.
\r
2 ! See http://factorcode.org/license.txt for BSD license.
\r
3 USING: deques dlists kernel threads continuations math
\r
4 concurrency.conditions combinators.short-circuit accessors
\r
6 IN: concurrency.locks
\r
8 ! Simple critical sections
\r
9 TUPLE: lock threads owner reentrant? ;
\r
11 : <lock> ( -- lock )
\r
12 <dlist> f f lock boa ;
\r
14 : <reentrant-lock> ( -- lock )
\r
15 <dlist> f t lock boa ;
\r
19 : acquire-lock ( lock timeout -- )
\r
21 [ 2dup [ threads>> ] dip "lock" wait ] when drop
\r
24 : release-lock ( lock -- )
\r
26 threads>> notify-1 ;
\r
28 :: do-lock ( lock timeout quot acquire release -- )
\r
29 lock timeout acquire call
\r
30 quot lock release curry [ ] cleanup ; inline
\r
32 : (with-lock) ( lock timeout quot -- )
\r
33 [ acquire-lock ] [ release-lock ] do-lock ; inline
\r
37 : with-lock-timeout ( lock timeout quot -- )
\r
39 pick owner>> self eq? [
\r
48 : with-lock ( lock quot -- )
\r
49 f swap with-lock-timeout ; inline
\r
51 ! Many-reader/single-writer locks
\r
52 TUPLE: rw-lock readers writers reader# writer ;
\r
54 : <rw-lock> ( -- lock )
\r
55 <dlist> <dlist> 0 f rw-lock boa ;
\r
59 : add-reader ( lock -- )
\r
60 [ 1 + ] change-reader# drop ;
\r
62 : acquire-read-lock ( lock timeout -- )
\r
64 [ 2dup [ readers>> ] dip "read lock" wait ] when drop
\r
67 : notify-writer ( lock -- )
\r
68 writers>> notify-1 ;
\r
70 : remove-reader ( lock -- )
\r
71 [ 1 - ] change-reader# drop ;
\r
73 : release-read-lock ( lock -- )
\r
75 dup reader#>> zero? [ notify-writer ] [ drop ] if ;
\r
77 : acquire-write-lock ( lock timeout -- )
\r
78 over writer>> pick reader#>> 0 > or
\r
79 [ 2dup [ writers>> ] dip "write lock" wait ] when drop
\r
80 self >>writer drop ;
\r
82 : release-write-lock ( lock -- )
\r
84 dup readers>> deque-empty?
\r
85 [ notify-writer ] [ readers>> notify-all ] if ;
\r
87 : reentrant-read-lock-ok? ( lock -- ? )
\r
88 #! If we already have a write lock, then we can grab a read
\r
92 : reentrant-write-lock-ok? ( lock -- ? )
\r
93 #! The only case where we have a writer and > 1 reader is
\r
94 #! write -> read re-entrancy, and in this case we prohibit
\r
95 #! a further write -> read -> write re-entrancy.
\r
96 { [ writer>> self eq? ] [ reader#>> zero? ] } 1&& ;
\r
100 : with-read-lock-timeout ( lock timeout quot -- )
\r
101 pick reentrant-read-lock-ok? [
\r
102 [ drop add-reader ] [ remove-reader ] do-lock
\r
104 [ acquire-read-lock ] [ release-read-lock ] do-lock
\r
107 : with-read-lock ( lock quot -- )
\r
108 f swap with-read-lock-timeout ; inline
\r
110 : with-write-lock-timeout ( lock timeout quot -- )
\r
111 pick reentrant-write-lock-ok? [ 2nip call ] [
\r
112 [ acquire-write-lock ] [ release-write-lock ] do-lock
\r
115 : with-write-lock ( lock quot -- )
\r
116 f swap with-write-lock-timeout ; inline
\r