ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Semaphore.pm
(Generate patch)

Comparing Coro/Coro/Semaphore.pm (file contents):
Revision 1.6 by root, Tue Jul 17 15:42:28 2001 UTC vs.
Revision 1.68 by root, Sun Sep 21 01:23:26 2008 UTC

… …
14 14
15 $sig->up; 15 $sig->up;
16 16
17=head1 DESCRIPTION 17=head1 DESCRIPTION
18 18
19This module implements counting semaphores. You can initialize a mutex
20with any level of parallel users, that is, you can intialize a sempahore
21that can be C<down>ed more than once until it blocks. There is no owner
22associated with semaphores, so one coroutine can C<down> it while another
23can C<up> it.
24
25Counting semaphores are typically used to coordinate access to
26resources, with the semaphore count initialized to the number of free
27resources. Coroutines then increment the count when resources are added
28and decrement the count when resources are removed.
29
19=over 4 30=over 4
20 31
21=cut 32=cut
22 33
23package Coro::Semaphore; 34package Coro::Semaphore;
24 35
36no warnings;
37
25use Coro (); 38use Coro ();
26 39
27$VERSION = 0.07; 40$VERSION = 4.746;
28 41
29=item new [inital count, default zero] 42=item new [inital count]
30 43
31Creates a new sempahore object with the given initial lock count. The 44Creates a new sempahore object with the given initial lock count. The
32default lock count is 1, which means it is unlocked by default. 45default lock count is 1, which means it is unlocked by default. Zero (or
46negative values) are also allowed, in which case the semaphore is locked
47by default.
33 48
34=cut 49=cut
35 50
36sub new { 51sub new {
37 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52 bless [defined $_[1] ? $_[1] : 1], $_[0];
38} 53}
39 54
55=item $sem->count
56
57Returns the current semaphore count.
58
59=cut
60
61sub count {
62 $_[0][0]
63}
64
65=item $sem->adjust ($diff)
66
67Atomically adds the amount given to the current semaphore count. If the
68count becomes positive, wakes up any waiters. Does not block if the count
69becomes negative, however.
70
71=cut
72
73sub adjust {
74 # basically a weird copy of up
75 if (($_[0][0] += $_[1]) > 0) {
76 (shift @{$_[0][1]})->ready if @{$_[0][1]};
77 }
78}
79
40=item $sem->down 80=item $sem->down
41 81
42Decrement the counter, therefore "locking" the semaphore. This method 82Decrement the counter, therefore "locking" the semaphore. This method
43waits until the semaphore is available if the counter is zero. 83waits until the semaphore is available if the counter is zero.
44 84
85=item $status = $sem->timed_down ($timeout)
86
87Like C<down>, but returns false if semaphore couldn't be acquired within
88$timeout seconds, otherwise true.
89
45=cut 90=cut
46 91
47sub down { 92sub down {
48 my $self = shift;
49 while ($self->[0] <= 0) { 93 while ($_[0][0] <= 0) {
50 push @{$self->[1]}, $Coro::current; 94 push @{$_[0][1]}, $Coro::current;
51 Coro::schedule; 95 &Coro::schedule;
52 } 96 }
53 --$self->[0]; 97 --$_[0][0];
98}
99
100sub timed_down {
101 require Coro::Timer;
102 my $timeout = Coro::Timer::timeout ($_[1]);
103
104 while ($_[0][0] <= 0) {
105 push @{$_[0][1]}, $Coro::current;
106 &Coro::schedule;
107 if ($timeout) {
108 # ugly as hell. slow, too, btw!
109 for (0..$#{$_[0][1]}) {
110 if ($_[0][1][$_] == $Coro::current) {
111 splice @{$_[0][1]}, $_, 1;
112 return;
113 }
114 }
115 die;
116 }
117 }
118
119 --$_[0][0];
120 return 1;
54} 121}
55 122
56=item $sem->up 123=item $sem->up
57 124
58Unlock the semaphore again. 125Unlock the semaphore again.
59 126
60=cut 127=cut
61 128
62sub up { 129sub up {
63 my $self = shift;
64 if (++$self->[0] > 0) { 130 if (++$_[0][0] > 0) {
65 (shift @{$self->[1]})->ready if @{$self->[1]}; 131 (shift @{$_[0][1]})->ready if @{$_[0][1]};
66 } 132 }
67} 133}
68 134
69=item $sem->try 135=item $sem->try
70 136
… …
72otherwise return false and leave the semaphore unchanged. 138otherwise return false and leave the semaphore unchanged.
73 139
74=cut 140=cut
75 141
76sub try { 142sub try {
77 my $self = shift;
78 if ($self->[0] > 0) { 143 if ($_[0][0] > 0) {
79 --$self->[0]; 144 --$_[0][0];
80 return 1; 145 return 1;
81 } else { 146 } else {
82 return 0; 147 return 0;
83 } 148 }
84} 149}
85 150
861; 151=item $sem->waiters
152
153In scalar context, returns the number of coroutines waiting for this
154semaphore.
155
156=cut
157
158sub waiters {
159 @{$_[0][1]};
160}
161
162=item $guard = $sem->guard
163
164This method calls C<down> and then creates a guard object. When the guard
165object is destroyed it automatically calls C<up>.
166
167=item $guard = $sem->timed_guard ($timeout)
168
169Like C<guard>, but returns undef if semaphore couldn't be acquired within
170$timeout seconds, otherwise the guard object.
171
172=cut
173
174sub guard {
175 &down;
176 # double indirection because bless works on the referenced
177 # object, not (only) on the reference itself.
178 bless \\$_[0], Coro::Semaphore::guard::;
179}
180
181sub timed_guard {
182 &timed_down
183 ? bless \\$_[0], Coro::Semaphore::guard::
184 : ();
185}
186
187sub Coro::Semaphore::guard::DESTROY {
188 &up(${${$_[0]}});
189}
87 190
88=back 191=back
89 192
90=head1 AUTHOR 193=head1 AUTHOR
91 194
92 Marc Lehmann <pcg@goof.com> 195 Marc Lehmann <schmorp@schmorp.de>
93 http://www.goof.com/pcg/marc/ 196 http://home.schmorp.de/
94 197
95=cut 198=cut
96 199
2001
201

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines