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.46 by root, Tue Aug 30 21:32:17 2005 UTC vs.
Revision 1.81 by root, Tue Nov 18 23:20:41 2008 UTC

31 31
32=cut 32=cut
33 33
34package Coro::Semaphore; 34package Coro::Semaphore;
35 35
36BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") } 36no warnings;
37 37
38use Coro (); 38use Coro ();
39 39
40$VERSION = 1.31; 40$VERSION = 5.0;
41 41
42=item new [inital count] 42=item new [inital count]
43 43
44Creates a new sempahore object with the given initial lock count. The 44Creates a new sempahore object with the given initial lock count. The
45default lock count is 1, which means it is unlocked by default. Zero (or 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 46negative values) are also allowed, in which case the semaphore is locked
47by default. 47by default.
48 48
49=cut 49=item $sem->count
50 50
51sub new { 51Returns the current semaphore count.
52 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52
53} 53=item $sem->adjust ($diff)
54
55Atomically adds the amount given to the current semaphore count. If the
56count becomes positive, wakes up any waiters. Does not block if the count
57becomes negative, however.
54 58
55=item $sem->down 59=item $sem->down
56 60
57Decrement the counter, therefore "locking" the semaphore. This method 61Decrement the counter, therefore "locking" the semaphore. This method
58waits until the semaphore is available if the counter is zero. 62waits until the semaphore is available if the counter is zero.
59 63
60=item $status = $sem->timed_down($timeout) 64=item $sem->wait
61 65
62Like C<down>, but returns false if semaphore couldn't be acquired within 66Similar to C<down>, but does not actually decrement the counter. Instead,
63$timeout seconds, otherwise true. 67when this function returns, a following call to C<down> or C<try> is
68guaranteed to succeed without blocking, until the next coroutine switch
69(C<cede> etc.).
70
71Note that using C<wait> is much less efficient than using C<down>, so try
72to prefer C<down> whenever possible.
64 73
65=cut 74=cut
66 75
67sub down { 76#=item $status = $sem->timed_down ($timeout)
68 while ($_[0][0] <= 0) { 77#
69 push @{$_[0][1]}, $Coro::current; 78#Like C<down>, but returns false if semaphore couldn't be acquired within
70 Coro::schedule; 79#$timeout seconds, otherwise true.
71 }
72 --$_[0][0];
73}
74 80
75sub timed_down { 81#sub timed_down {
76 require Coro::Timer; 82# require Coro::Timer;
77 my $timeout = Coro::Timer::timeout($_[1]); 83# my $timeout = Coro::Timer::timeout ($_[1]);
78 84#
79 while ($_[0][0] <= 0) { 85# while ($_[0][0] <= 0) {
80 push @{$_[0][1]}, $Coro::current; 86# push @{$_[0][1]}, $Coro::current;
81 Coro::schedule; 87# &Coro::schedule;
82 if ($timeout) { 88# if ($timeout) {
83 # ugly as hell. slow, too, btw! 89# # ugly as hell. slow, too, btw!
84 for (0..$#{$_[0][1]}) { 90# for (0..$#{$_[0][1]}) {
85 if ($_[0][1][$_] == $Coro::current) { 91# if ($_[0][1][$_] == $Coro::current) {
86 splice @{$_[0][1]}, $_, 1; 92# splice @{$_[0][1]}, $_, 1;
87 return; 93# return;
88 } 94# }
89 } 95# }
90 die; 96# die;
91 } 97# }
92 } 98# }
93 99#
94 --$_[0][0]; 100# --$_[0][0];
95 return 1; 101# return 1;
96} 102#}
97 103
98=item $sem->up 104=item $sem->up
99 105
100Unlock the semaphore again. 106Unlock the semaphore again.
101
102=cut
103
104sub up {
105 if (++$_[0][0] > 0) {
106 (shift @{$_[0][1]})->ready if @{$_[0][1]};
107 }
108}
109 107
110=item $sem->try 108=item $sem->try
111 109
112Try to C<down> the semaphore. Returns true when this was possible, 110Try to C<down> the semaphore. Returns true when this was possible,
113otherwise return false and leave the semaphore unchanged. 111otherwise return false and leave the semaphore unchanged.
114 112
115=cut
116
117sub try {
118 if ($_[0][0] > 0) {
119 --$_[0][0];
120 return 1;
121 } else {
122 return 0;
123 }
124}
125
126=item $sem->waiters 113=item $sem->waiters
127 114
128In scalar context, returns the number of coroutines waiting for this 115In scalar context, returns the number of coroutines waiting for this
129semaphore. 116semaphore.
130 117
131=cut
132
133sub waiters {
134 @{$_[0][1]};
135}
136
137=item $guard = $sem->guard 118=item $guard = $sem->guard
138 119
139This method calls C<down> and then creates a guard object. When the guard 120This method calls C<down> and then creates a guard object. When the guard
140object is destroyed it automatically calls C<up>. 121object is destroyed it automatically calls C<up>.
141
142=item $guard = $sem->timed_guard($timeout)
143
144Like C<guard>, but returns undef if semaphore couldn't be acquired within
145$timeout seconds, otherwise the guard object.
146 122
147=cut 123=cut
148 124
149sub guard { 125sub guard {
150 &down; 126 &down;
151 # double indirection because bless works on the referenced 127 # double indirection because bless works on the referenced
152 # object, not (only) on the reference itself. 128 # object, not (only) on the reference itself.
153 bless \\$_[0], Coro::Semaphore::guard::; 129 bless \\$_[0], Coro::Semaphore::guard::;
154} 130}
155 131
132#=item $guard = $sem->timed_guard ($timeout)
133#
134#Like C<guard>, but returns undef if semaphore couldn't be acquired within
135#$timeout seconds, otherwise the guard object.
136
156sub timed_guard { 137#sub timed_guard {
157 &timed_down 138# &timed_down
158 ? bless \\$_[0], Coro::Semaphore::guard:: 139# ? bless \\$_[0], Coro::Semaphore::guard::
159 : (); 140# : ();
160} 141#}
161 142
162sub Coro::Semaphore::guard::DESTROY { 143sub Coro::Semaphore::guard::DESTROY {
163 &up(${${$_[0]}}); 144 &up(${${$_[0]}});
164} 145}
165
1661;
167 146
168=back 147=back
169 148
170=head1 AUTHOR 149=head1 AUTHOR
171 150
172 Marc Lehmann <schmorp@schmorp.de> 151 Marc Lehmann <schmorp@schmorp.de>
173 http://home.schmorp.de/ 152 http://home.schmorp.de/
174 153
175=cut 154=cut
176 155
1561
157

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines