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.67 by root, Wed Jul 23 22:15:25 2008 UTC vs.
Revision 1.114 by root, Wed Feb 23 07:14:21 2011 UTC

1=head1 NAME 1=head1 NAME
2 2
3Coro::Semaphore - non-binary semaphores 3Coro::Semaphore - counting semaphores
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Coro::Semaphore; 7 use Coro;
8 8
9 $sig = new Coro::Semaphore [initial value]; 9 $sig = new Coro::Semaphore [initial value];
10 10
11 $sig->down; # wait for signal 11 $sig->down; # wait for signal
12 12
17=head1 DESCRIPTION 17=head1 DESCRIPTION
18 18
19This module implements counting semaphores. You can initialize a mutex 19This module implements counting semaphores. You can initialize a mutex
20with any level of parallel users, that is, you can intialize a sempahore 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 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 22associated with semaphores, so one thread can C<down> it while another
23can C<up> it. 23can C<up> it.
24 24
25Counting semaphores are typically used to coordinate access to 25Counting semaphores are typically used to coordinate access to
26resources, with the semaphore count initialized to the number of free 26resources, with the semaphore count initialized to the number of free
27resources. Coroutines then increment the count when resources are added 27resources. Threads then increment the count when resources are added
28and decrement the count when resources are removed. 28and decrement the count when resources are removed.
29
30You don't have to load C<Coro::Semaphore> manually, it will be loaded
31automatically when you C<use Coro> and call the C<new> constructor.
29 32
30=over 4 33=over 4
31 34
32=cut 35=cut
33 36
34package Coro::Semaphore; 37package Coro::Semaphore;
35 38
36no warnings; 39use common::sense;
37 40
38use Coro (); 41use Coro ();
39 42
40$VERSION = 4.745; 43our $VERSION = 5.372;
41 44
42=item new [inital count] 45=item new [inital count]
43 46
44Creates a new sempahore object with the given initial lock count. The 47Creates 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 48default 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 49negative values) are also allowed, in which case the semaphore is locked
47by default. 50by default.
48 51
49=cut
50
51sub new {
52 bless [defined $_[1] ? $_[1] : 1], $_[0];
53}
54
55=item $sem->count 52=item $sem->count
56 53
57Returns the current semaphore count. 54Returns the current semaphore count.
58
59=cut
60
61sub count {
62 $_[0][0]
63}
64 55
65=item $sem->adjust ($diff) 56=item $sem->adjust ($diff)
66 57
67Atomically adds the amount given to the current semaphore count. If the 58Atomically adds the amount given to the current semaphore count. If the
68count becomes positive, wakes up any waiters. Does not block if the count 59count becomes positive, wakes up any waiters. Does not block if the count
69becomes negative, however. 60becomes negative, however.
70 61
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
80=item $sem->down 62=item $sem->down
81 63
82Decrement the counter, therefore "locking" the semaphore. This method 64Decrement the counter, therefore "locking" the semaphore. This method
83waits until the semaphore is available if the counter is zero. 65waits until the semaphore is available if the counter is zero.
84 66
85=item $status = $sem->timed_down ($timeout) 67=item $sem->wait
86 68
87Like C<down>, but returns false if semaphore couldn't be acquired within 69Similar to C<down>, but does not actually decrement the counter. Instead,
88$timeout seconds, otherwise true. 70when this function returns, a following call to C<down> or C<try> is
71guaranteed to succeed without blocking, until the next thread switch
72(C<cede> etc.).
73
74Note that using C<wait> is much less efficient than using C<down>, so try
75to prefer C<down> whenever possible.
76
77=item $sem->wait ($callback)
78
79If you pass a callback argument to C<wait>, it will not wait, but
80immediately return. The callback will be called as soon as the semaphore
81becomes available (which might be instantly), and gets passed the
82semaphore as first argument.
83
84The callback might C<down> the semaphore exactly once, might wake up other
85threads, but is I<NOT> allowed to block (switch to other threads).
89 86
90=cut 87=cut
91 88
92sub down { 89#=item $status = $sem->timed_down ($timeout)
93 while ($_[0][0] <= 0) { 90#
94 push @{$_[0][1]}, $Coro::current; 91#Like C<down>, but returns false if semaphore couldn't be acquired within
95 &Coro::schedule; 92#$timeout seconds, otherwise true.
96 }
97 --$_[0][0];
98}
99 93
100sub timed_down { 94#sub timed_down {
101 require Coro::Timer; 95# require Coro::Timer;
102 my $timeout = Coro::Timer::timeout ($_[1]); 96# my $timeout = Coro::Timer::timeout ($_[1]);
103 97#
104 while ($_[0][0] <= 0) { 98# while ($_[0][0] <= 0) {
105 push @{$_[0][1]}, $Coro::current; 99# push @{$_[0][1]}, $Coro::current;
106 &Coro::schedule; 100# &Coro::schedule;
107 if ($timeout) { 101# if ($timeout) {
108 # ugly as hell. slow, too, btw! 102# # ugly as hell. slow, too, btw!
109 for (0..$#{$_[0][1]}) { 103# for (0..$#{$_[0][1]}) {
110 if ($_[0][1][$_] == $Coro::current) { 104# if ($_[0][1][$_] == $Coro::current) {
111 splice @{$_[0][1]}, $_, 1; 105# splice @{$_[0][1]}, $_, 1;
112 return; 106# return;
113 } 107# }
114 } 108# }
115 die; 109# die;
116 } 110# }
117 } 111# }
118 112#
119 --$_[0][0]; 113# --$_[0][0];
120 return 1; 114# return 1;
121} 115#}
122 116
123=item $sem->up 117=item $sem->up
124 118
125Unlock the semaphore again. 119Unlock the semaphore again.
126
127=cut
128
129sub up {
130 if (++$_[0][0] > 0) {
131 (shift @{$_[0][1]})->ready if @{$_[0][1]};
132 }
133}
134 120
135=item $sem->try 121=item $sem->try
136 122
137Try to C<down> the semaphore. Returns true when this was possible, 123Try to C<down> the semaphore. Returns true when this was possible,
138otherwise return false and leave the semaphore unchanged. 124otherwise return false and leave the semaphore unchanged.
139 125
140=cut
141
142sub try {
143 if ($_[0][0] > 0) {
144 --$_[0][0];
145 return 1;
146 } else {
147 return 0;
148 }
149}
150
151=item $sem->waiters 126=item $sem->waiters
152 127
153In scalar context, returns the number of coroutines waiting for this 128In scalar context, returns the number of threads waiting for this
154semaphore. 129semaphore.
155
156=cut
157
158sub waiters {
159 @{$_[0][1]};
160}
161 130
162=item $guard = $sem->guard 131=item $guard = $sem->guard
163 132
164This method calls C<down> and then creates a guard object. When the guard 133This method calls C<down> and then creates a guard object. When the guard
165object is destroyed it automatically calls C<up>. 134object is destroyed it automatically calls C<up>.
166 135
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 136=cut
173 137
174sub guard { 138sub guard {
175 &down; 139 &down;
176 # double indirection because bless works on the referenced
177 # object, not (only) on the reference itself.
178 bless \\$_[0], Coro::Semaphore::guard::; 140 bless [$_[0]], Coro::Semaphore::guard::
179} 141}
180 142
143#=item $guard = $sem->timed_guard ($timeout)
144#
145#Like C<guard>, but returns undef if semaphore couldn't be acquired within
146#$timeout seconds, otherwise the guard object.
147
181sub timed_guard { 148#sub timed_guard {
182 &timed_down 149# &timed_down
183 ? bless \\$_[0], Coro::Semaphore::guard:: 150# ? bless \\$_[0], Coro::Semaphore::guard::
184 : (); 151# : ();
185} 152#}
186 153
187sub Coro::Semaphore::guard::DESTROY { 154sub Coro::Semaphore::guard::DESTROY {
188 &up(${${$_[0]}}); 155 &up($_[0][0]);
189} 156}
190 157
191=back 158=back
192 159
193=head1 AUTHOR 160=head1 AUTHOR

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines