1MCE::Shared::Condvar(3)User Contributed Perl DocumentatioMnCE::Shared::Condvar(3)
2
3
4
6 MCE::Shared::Condvar - Condvar helper class
7
9 This document describes MCE::Shared::Condvar version 1.840
10
12 This helper class for MCE::Shared provides a "Scalar", "Mutex", and
13 primitives for conditional locking.
14
16 use MCE::Shared;
17
18 my $cv = MCE::Shared->condvar( 0 );
19
20 # OO interface
21
22 $val = $cv->set( $val );
23 $val = $cv->get();
24 $len = $cv->len();
25
26 # conditional locking primitives
27
28 $cv->lock();
29 $cv->unlock();
30 $cv->broadcast(0.05); # delay before broadcasting
31 $cv->broadcast();
32 $cv->signal(0.05); # delay before signaling
33 $cv->signal();
34 $cv->timedwait(2.5);
35 $cv->wait();
36
37 # included, sugar methods without having to call set/get explicitly
38
39 $val = $cv->append( $string ); # $val .= $string
40 $val = $cv->decr(); # --$val
41 $val = $cv->decrby( $number ); # $val -= $number
42 $val = $cv->getdecr(); # $val--
43 $val = $cv->getincr(); # $val++
44 $val = $cv->incr(); # ++$val
45 $val = $cv->incrby( $number ); # $val += $number
46 $old = $cv->getset( $new ); # $o = $v, $v = $n, $o
47
49 The following example demonstrates barrier synchronization.
50
51 use MCE;
52 use MCE::Shared;
53 use Time::HiRes qw(usleep);
54
55 my $num_workers = 8;
56 my $count = MCE::Shared->condvar(0);
57 my $state = MCE::Shared->scalar('ready');
58
59 my $microsecs = ( lc $^O =~ /mswin|mingw|msys|cygwin/ ) ? 0 : 200;
60
61 # The lock is released upon entering ->broadcast, ->signal, ->timedwait,
62 # and ->wait. For performance reasons, the condition variable is *not*
63 # re-locked prior to exiting the call. Therefore, obtain the lock when
64 # synchronization is desired subsequently.
65
66 sub barrier_sync {
67 usleep($microsecs) while $state->get eq 'down';
68
69 $count->lock;
70 $state->set('up'), $count->incr;
71
72 if ($count->get == $num_workers) {
73 $count->decr, $state->set('down');
74 $count->broadcast;
75 }
76 else {
77 $count->wait while $state->get eq 'up';
78 $count->lock;
79 $state->set('ready') if $count->decr == 0;
80 $count->unlock;
81 }
82 }
83
84 sub user_func {
85 my $id = MCE->wid;
86 for (1 .. 400) {
87 MCE->print("$_: $id\n");
88 barrier_sync(); # made possible by MCE::Shared::Condvar
89 # MCE->sync(); # same thing via the MCE-Core API
90 }
91 }
92
93 my $mce = MCE->new(
94 max_workers => $num_workers,
95 user_func => \&user_func
96 )->run;
97
98 # Time taken from a 2.6 GHz machine running Mac OS X.
99 # threads::shared: 0.207s Perl threads
100 # forks::shared: 36.426s child processes
101 # MCE::Shared: 0.353s child processes
102 # MCE Sync: 0.062s child processes
103
105 new ( [ value ] )
106 Constructs a new condition variable. Its value defaults to 0 when
107 "value" is not specified.
108
109 use MCE::Shared;
110
111 $cv = MCE::Shared->condvar( 100 );
112 $cv = MCE::Shared->condvar;
113
114 set ( value )
115 Sets the value associated with the "cv" object. The new value is
116 returned in scalar context.
117
118 $val = $cv->set( 10 );
119 $cv->set( 10 );
120
121 get
122 Returns the value associated with the "cv" object.
123
124 $val = $cv->get;
125
126 len
127 Returns the length of the value. It returns the "undef" value if the
128 value is not defined.
129
130 $len = $var->len;
131
132 lock
133 Attempts to grab the lock and waits if not available. Multiple calls
134 to "$cv-"lock> by the same process or thread is safe. The mutex will
135 remain locked until "$cv-"unlock> is called.
136
137 $cv->lock;
138
139 unlock
140 Releases the lock. A held lock by an exiting process or thread is
141 released automatically.
142
143 $cv->unlock;
144
145 signal ( [ floating_seconds ] )
146 Releases a held lock on the variable. Then, unblocks one process or
147 thread that's "wait"ing on that variable. The variable is *not*
148 locked upon return.
149
150 Optionally, delay "floating_seconds" before signaling.
151
152 $count->signal;
153 $count->signal( 0.5 );
154
155 broadcast ( [ floating_seconds ] )
156 The "broadcast" method works similarly to "signal". It releases a
157 held lock on the variable. Then, unblocks all the processes or
158 threads that are blocked in a condition "wait" on the variable,
159 rather than only one. The variable is *not* locked upon return.
160
161 Optionally, delay "floating_seconds" before broadcasting.
162
163 $count->broadcast;
164 $count->broadcast( 0.5 );
165
166 wait
167 Releases a held lock on the variable. Then, waits until another
168 thread does a "signal" or "broadcast" for the same variable. The
169 variable is *not* locked upon return.
170
171 $count->wait() while $state->get() eq "bar";
172
173 timedwait ( floating_seconds )
174 Releases a held lock on the variable. Then, waits until another
175 thread does a "signal" or "broadcast" for the same variable or if
176 the timeout exceeds "floating_seconds".
177
178 A false value is returned if the timeout is reached, and a true
179 value otherwise. In either case, the variable is *not* locked upon
180 return.
181
182 $count->timedwait( 10 ) while $state->get() eq "foo";
183
185 This module is equipped with sugar methods to not have to call "set"
186 and "get" explicitly. In shared context, the benefit is atomicity and
187 reduction in inter-process communication.
188
189 The API resembles a subset of the Redis primitives
190 <http://redis.io/commands#strings> without the key argument.
191
192 append ( value )
193 Appends a value at the end of the current value and returns its new
194 length.
195
196 $len = $cv->append( "foo" );
197
198 decr
199 Decrements the value by one and returns its new value.
200
201 $num = $cv->decr;
202
203 decrby ( number )
204 Decrements the value by the given number and returns its new value.
205
206 $num = $cv->decrby( 2 );
207
208 getdecr
209 Decrements the value by one and returns its old value.
210
211 $old = $cv->getdecr;
212
213 getincr
214 Increments the value by one and returns its old value.
215
216 $old = $cv->getincr;
217
218 getset ( value )
219 Sets the value and returns its old value.
220
221 $old = $cv->getset( "baz" );
222
223 incr
224 Increments the value by one and returns its new value.
225
226 $num = $cv->incr;
227
228 incrby ( number )
229 Increments the value by the given number and returns its new value.
230
231 $num = $cv->incrby( 2 );
232
234 The MCE example <https://github.com/marioroy/mce-
235 examples/tree/master/chameneos> is derived from the chameneos example
236 <http://benchmarksgame.alioth.debian.org/u64q/program.php?test=chameneosredux&lang=perl&id=4>
237 by Jonathan DePeri and Andrew Rodland.
238
239 use 5.010;
240 use strict;
241 use warnings;
242
243 use MCE::Hobo;
244 use MCE::Shared;
245 use Time::HiRes 'time';
246
247 die 'No argument given' if not @ARGV;
248
249 my $start = time;
250 my %color = ( blue => 1, red => 2, yellow => 4 );
251
252 my ( @colors, @complement );
253
254 @colors[values %color] = keys %color;
255
256 for my $triple (
257 [qw(blue blue blue)],
258 [qw(red red red)],
259 [qw(yellow yellow yellow)],
260 [qw(blue red yellow)],
261 [qw(blue yellow red)],
262 [qw(red blue yellow)],
263 [qw(red yellow blue)],
264 [qw(yellow red blue)],
265 [qw(yellow blue red)],
266 ) {
267 $complement[ $color{$triple->[0]} | $color{$triple->[1]} ] =
268 $color{$triple->[2]};
269 }
270
271 my @numbers = qw(zero one two three four five six seven eight nine);
272
273 sub display_complements
274 {
275 for my $i (1, 2, 4) {
276 for my $j (1, 2, 4) {
277 print "$colors[$i] + $colors[$j] -> $colors[ $complement[$i | $j] ]\n";
278 }
279 }
280 print "\n";
281 }
282
283 sub num2words
284 {
285 join ' ', '', map $numbers[$_], split //, shift;
286 }
287
288 # Construct condvars and queues first before other shared objects or in
289 # any order when IO::FDPass is installed, used by MCE::Shared::Server.
290
291 my $meetings = MCE::Shared->condvar();
292
293 tie my @creatures, 'MCE::Shared';
294 tie my $first, 'MCE::Shared', undef;
295 tie my @met, 'MCE::Shared';
296 tie my @met_self, 'MCE::Shared';
297
298 sub chameneos
299 {
300 my $id = shift;
301
302 while (1) {
303 $meetings->lock();
304
305 unless ($meetings->get()) {
306 $meetings->unlock();
307 last;
308 }
309
310 if (defined $first) {
311 $creatures[$first] = $creatures[$id] =
312 $complement[$creatures[$first] | $creatures[$id]];
313
314 $met_self[$first]++ if ($first == $id);
315 $met[$first]++; $met[$id]++;
316 $meetings->decr();
317 $first = undef;
318
319 # Unlike threads::shared (condvar) which retains the lock
320 # while in the scope, MCE::Shared signal and wait methods
321 # must be called prior to leaving the block, due to lock
322 # being released upon return.
323
324 $meetings->signal();
325 }
326 else {
327 $first = $id;
328 $meetings->wait(); # ditto ^^
329 }
330 }
331 }
332
333 sub pall_mall
334 {
335 my $N = shift;
336 @creatures = map $color{$_}, @_;
337 my @threads;
338
339 print " ", join(" ", @_);
340 $meetings->set($N);
341
342 for (0 .. $#creatures) {
343 $met[$_] = $met_self[$_] = 0;
344 push @threads, MCE::Hobo->create(\&chameneos, $_);
345 }
346 for (@threads) {
347 $_->join();
348 }
349
350 $meetings->set(0);
351
352 for (0 .. $#creatures) {
353 print "\n$met[$_]", num2words($met_self[$_]);
354 $meetings->incrby($met[$_]);
355 }
356
357 print "\n", num2words($meetings->get()), "\n\n";
358 }
359
360 display_complements();
361
362 pall_mall($ARGV[0], qw(blue red yellow));
363 pall_mall($ARGV[0], qw(blue red yellow red yellow blue red yellow red blue));
364
365 printf "duration: %0.03f\n", time - $start;
366
368 The conditional locking feature is inspired by threads::shared.
369
371 Perl must have IO::FDPass for constructing a shared "condvar" or
372 "queue" while the shared-manager process is running. For platforms
373 where IO::FDPass isn't possible, construct "condvar" and "queue" before
374 other classes. On systems without "IO::FDPass", the manager process is
375 delayed until sharing other classes or started explicitly.
376
377 use MCE::Shared;
378
379 my $has_IO_FDPass = $INC{'IO/FDPass.pm'} ? 1 : 0;
380
381 my $cv = MCE::Shared->condvar();
382 my $que = MCE::Shared->queue();
383
384 MCE::Shared->start() unless $has_IO_FDPass;
385
386 Regarding mce_open, "IO::FDPass" is needed for constructing a shared-
387 handle from a non-shared handle not yet available inside the shared-
388 manager process. The workaround is to have the non-shared handle made
389 before the shared-manager is started. Passing a file by reference is
390 fine for the three STD* handles.
391
392 # The shared-manager knows of \*STDIN, \*STDOUT, \*STDERR.
393
394 mce_open my $shared_in, "<", \*STDIN; # ok
395 mce_open my $shared_out, ">>", \*STDOUT; # ok
396 mce_open my $shared_err, ">>", \*STDERR; # ok
397 mce_open my $shared_fh1, "<", "/path/to/sequence.fasta"; # ok
398 mce_open my $shared_fh2, ">>", "/path/to/results.log"; # ok
399
400 mce_open my $shared_fh, ">>", \*NON_SHARED_FH; # requires IO::FDPass
401
402 The IO::FDPass module is known to work reliably on most platforms.
403 Install 1.1 or later to rid of limitations described above.
404
405 perl -MIO::FDPass -le "print 'Cheers! Perl has IO::FDPass.'"
406
408 MCE, MCE::Hobo, MCE::Shared
409
411 Mario E. Roy, <marioeroy AT gmail DOT com>
412
413
414
415perl v5.28.1 2019-01-04 MCE::Shared::Condvar(3)