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.17 by root, Thu Aug 30 03:35:55 2001 UTC vs.
Revision 1.83 by root, Thu Nov 20 09:37:21 2008 UTC

… …
31 31
32=cut 32=cut
33 33
34package Coro::Semaphore; 34package Coro::Semaphore;
35 35
36no warnings;
37
36use Coro (); 38use Coro ();
37 39
38$VERSION = 0.45; 40$VERSION = "5.0";
39 41
40=item new [inital count] 42=item new [inital count]
41 43
42Creates a new sempahore object with the given initial lock count. The 44Creates a new sempahore object with the given initial lock count. The
43default 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
44negative values) are also allowed, in which case the semaphore is locked 46negative values) are also allowed, in which case the semaphore is locked
45by default. 47by default.
46 48
47=cut 49=item $sem->count
48 50
49sub new { 51Returns the current semaphore count.
50 bless [defined $_[1] ? $_[1] : 1], $_[0]; 52
51} 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.
52 58
53=item $sem->down 59=item $sem->down
54 60
55Decrement the counter, therefore "locking" the semaphore. This method 61Decrement the counter, therefore "locking" the semaphore. This method
56waits until the semaphore is available if the counter is zero. 62waits until the semaphore is available if the counter is zero.
57 63
64=item $sem->wait
65
66Similar to C<down>, but does not actually decrement the counter. Instead,
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.
73
74=item $sem->wait ($callback)
75
76If you pass a callback argument to C<wait>, it will not wait, but
77immediately return. The callback will be called as soon as the semaphore
78becomes available (which might be instantly), and gets passed the
79semaphore as first argument.
80
81The callback might C<down> the semaphore exactly once, might wake up other
82coroutines, but is I<NOT> allowed to block (switch to other coroutines).
83
84This is considered a rather experimental interface, and is subject to
85change.
86
58=cut 87=cut
59 88
60sub down { 89#=item $status = $sem->timed_down ($timeout)
90#
91#Like C<down>, but returns false if semaphore couldn't be acquired within
92#$timeout seconds, otherwise true.
93
94#sub timed_down {
95# require Coro::Timer;
96# my $timeout = Coro::Timer::timeout ($_[1]);
97#
61 while ($_[0][0] <= 0) { 98# while ($_[0][0] <= 0) {
62 push @{$_[0][1]}, $Coro::current; 99# push @{$_[0][1]}, $Coro::current;
63 Coro::schedule; 100# &Coro::schedule;
101# if ($timeout) {
102# # ugly as hell. slow, too, btw!
103# for (0..$#{$_[0][1]}) {
104# if ($_[0][1][$_] == $Coro::current) {
105# splice @{$_[0][1]}, $_, 1;
106# return;
107# }
108# }
109# die;
110# }
64 } 111# }
112#
65 --$_[0][0]; 113# --$_[0][0];
66} 114# return 1;
115#}
67 116
68=item $sem->up 117=item $sem->up
69 118
70Unlock the semaphore again. 119Unlock the semaphore again.
71
72=cut
73
74sub up {
75 if (++$_[0][0] > 0) {
76 (shift @{$_[0][1]})->ready if @{$_[0][1]};
77 }
78}
79 120
80=item $sem->try 121=item $sem->try
81 122
82Try to C<down> the semaphore. Returns true when this was possible, 123Try to C<down> the semaphore. Returns true when this was possible,
83otherwise return false and leave the semaphore unchanged. 124otherwise return false and leave the semaphore unchanged.
84 125
85=cut
86
87sub try {
88 if ($_[0][0] > 0) {
89 --$_[0][0];
90 return 1;
91 } else {
92 return 0;
93 }
94}
95
96=item $sem->waiters 126=item $sem->waiters
97 127
98In scalar context, returns the number of coroutines waiting for this 128In scalar context, returns the number of coroutines waiting for this
99semaphore. 129semaphore.
100
101=cut
102
103sub waiters {
104 @{$_[0][1]};
105}
106 130
107=item $guard = $sem->guard 131=item $guard = $sem->guard
108 132
109This 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
110object is destroyed it automatically calls C<up>. 134object is destroyed it automatically calls C<up>.
… …
113 137
114sub guard { 138sub guard {
115 &down; 139 &down;
116 # double indirection because bless works on the referenced 140 # double indirection because bless works on the referenced
117 # object, not (only) on the reference itself. 141 # object, not (only) on the reference itself.
118 bless \\$_[0], Coro::Semaphore::Guard::; 142 bless \\$_[0], Coro::Semaphore::guard::;
119} 143}
120 144
145#=item $guard = $sem->timed_guard ($timeout)
146#
147#Like C<guard>, but returns undef if semaphore couldn't be acquired within
148#$timeout seconds, otherwise the guard object.
149
150#sub timed_guard {
151# &timed_down
152# ? bless \\$_[0], Coro::Semaphore::guard::
153# : ();
154#}
155
121sub Coro::Semaphore::Guard::DESTROY { 156sub Coro::Semaphore::guard::DESTROY {
122 &up(${${$_[0]}}); 157 &up(${${$_[0]}});
123} 158}
124
1251;
126 159
127=back 160=back
128 161
129=head1 AUTHOR 162=head1 AUTHOR
130 163
131 Marc Lehmann <pcg@goof.com> 164 Marc Lehmann <schmorp@schmorp.de>
132 http://www.goof.com/pcg/marc/ 165 http://home.schmorp.de/
133 166
134=cut 167=cut
135 168
1691
170

Diff Legend

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