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

Diff Legend

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