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.16 by root, Thu Aug 30 02:58:17 2001 UTC vs.
Revision 1.100 by root, Tue Jul 28 02:04:21 2009 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::Semaphore;
8 8
… …
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 29
30=over 4 30=over 4
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.162;
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 thread 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
82threads, but is I<NOT> allowed to block (switch to other threads).
83
58=cut 84=cut
59 85
60sub down { 86#=item $status = $sem->timed_down ($timeout)
61 my $self = shift; 87#
88#Like C<down>, but returns false if semaphore couldn't be acquired within
89#$timeout seconds, otherwise true.
90
91#sub timed_down {
92# require Coro::Timer;
93# my $timeout = Coro::Timer::timeout ($_[1]);
94#
62 while ($self->[0] <= 0) { 95# while ($_[0][0] <= 0) {
63 push @{$self->[1]}, $Coro::current; 96# push @{$_[0][1]}, $Coro::current;
64 Coro::schedule; 97# &Coro::schedule;
98# if ($timeout) {
99# # ugly as hell. slow, too, btw!
100# for (0..$#{$_[0][1]}) {
101# if ($_[0][1][$_] == $Coro::current) {
102# splice @{$_[0][1]}, $_, 1;
103# return;
104# }
105# }
106# die;
107# }
65 } 108# }
66 --$self->[0]; 109#
67} 110# --$_[0][0];
111# return 1;
112#}
68 113
69=item $sem->up 114=item $sem->up
70 115
71Unlock the semaphore again. 116Unlock the semaphore again.
72
73=cut
74
75sub up {
76 my $self = shift;
77 if (++$self->[0] > 0) {
78 (shift @{$self->[1]})->ready if @{$self->[1]};
79 }
80}
81 117
82=item $sem->try 118=item $sem->try
83 119
84Try to C<down> the semaphore. Returns true when this was possible, 120Try to C<down> the semaphore. Returns true when this was possible,
85otherwise return false and leave the semaphore unchanged. 121otherwise return false and leave the semaphore unchanged.
86 122
87=cut
88
89sub try {
90 my $self = shift;
91 if ($self->[0] > 0) {
92 --$self->[0];
93 return 1;
94 } else {
95 return 0;
96 }
97}
98
99=item $sem->waiters 123=item $sem->waiters
100 124
101In scalar context, returns the number of coroutines waiting for this 125In scalar context, returns the number of threads waiting for this
102semaphore. 126semaphore.
103
104=cut
105
106sub waiters {
107 @{$_[0][1]};
108}
109 127
110=item $guard = $sem->guard 128=item $guard = $sem->guard
111 129
112This method calls C<down> and then creates a guard object. When the guard 130This method calls C<down> and then creates a guard object. When the guard
113object is destroyed it automatically calls C<up>. 131object is destroyed it automatically calls C<up>.
114 132
115=cut 133=cut
116 134
117sub guard { 135sub guard {
118 &down; 136 &down;
119 # double indirection because bless works on the referenced
120 # object, not (only) on the reference itself.
121 bless \\$_[0], Coro::Semaphore::Guard::; 137 bless [$_[0]], Coro::Semaphore::guard::
122} 138}
123 139
140#=item $guard = $sem->timed_guard ($timeout)
141#
142#Like C<guard>, but returns undef if semaphore couldn't be acquired within
143#$timeout seconds, otherwise the guard object.
144
145#sub timed_guard {
146# &timed_down
147# ? bless \\$_[0], Coro::Semaphore::guard::
148# : ();
149#}
150
124sub Coro::Semaphore::Guard::DESTROY { 151sub Coro::Semaphore::guard::DESTROY {
125 &up(${${$_[0]}}); 152 &up($_[0][0]);
126} 153}
127
1281;
129 154
130=back 155=back
131 156
132=head1 AUTHOR 157=head1 AUTHOR
133 158
134 Marc Lehmann <pcg@goof.com> 159 Marc Lehmann <schmorp@schmorp.de>
135 http://www.goof.com/pcg/marc/ 160 http://home.schmorp.de/
136 161
137=cut 162=cut
138 163
1641
165

Diff Legend

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