1MCE::Shared::Condvar(3)User Contributed Perl DocumentatioMnCE::Shared::Condvar(3)
2
6 MCE::Shared::Condvar - Condvar helper class
7
9 This document describes MCE::Shared::Condvar version 1.880
10
12 This helper class for MCE::Shared provides a "Scalar", "Mutex", and
13 primitives for conditional locking.
14
16 use MCE::Shared;
17 my $cv = MCE::Shared->condvar( 0 );
19 # OO interface
21 $val = $cv->set( $val );
23 $val = $cv->get();
24 $len = $cv->len();
25 # conditional locking primitives
27 $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 # included, sugar methods without having to call set/get explicitly
38 $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 use MCE;
52 use MCE::Shared;
53 use Time::HiRes qw(usleep);
54 my $num_workers = 8;
56 my $count = MCE::Shared->condvar(0);
57 my $state = MCE::Shared->scalar('ready');
58 my $microsecs = ( $^O =~ /mswin|mingw|msys|cygwin/i ) ? 0 : 200;
60 # 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 sub barrier_sync {
67 usleep($microsecs) while $state->get eq 'down';
68 $count->lock;
70 $state->set('up'), $count->incr;
71 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 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 my $mce = MCE->new(
94 max_workers => $num_workers,
95 user_func => \&user_func
96 )->run;
97 # 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 MCE::Shared::Condvar->new ( )
106 Called by MCE::Shared for constructing a shared-condvar object.
107 MCE::Shared->condvar ( [ value ] )
109 Constructs a new condition variable. Its value defaults to 0 when
110 "value" is not specified.
111 use MCE::Shared;
113 $cv = MCE::Shared->condvar( 100 );
115 $cv = MCE::Shared->condvar;
116 set ( value )
118 Sets the value associated with the "cv" object. The new value is
119 returned in scalar context.
120 $val = $cv->set( 10 );
122 $cv->set( 10 );
123 get
125 Returns the value associated with the "cv" object.
126 $val = $cv->get;
128 len
130 Returns the length of the value. It returns the "undef" value if the
131 value is not defined.
132 $len = $var->len;
134 lock
136 Attempts to grab the lock and waits if not available. Multiple calls to
137 "$cv->lock" by the same process or thread is safe. The mutex will
138 remain locked until "$cv->unlock" is called.
139 $cv->lock;
141 unlock
143 Releases the lock. A held lock by an exiting process or thread is
144 released automatically.
145 $cv->unlock;
147 signal ( [ floating_seconds ] )
149 Releases a held lock on the variable. Then, unblocks one process or
150 thread that's "wait"ing on that variable. The variable is *not* locked
151 upon return.
152 Optionally, delay "floating_seconds" before signaling.
154 $count->signal;
156 $count->signal( 0.5 );
157 broadcast ( [ floating_seconds ] )
159 The "broadcast" method works similarly to "signal". It releases a held
160 lock on the variable. Then, unblocks all the processes or threads that
161 are blocked in a condition "wait" on the variable, rather than only
162 one. The variable is *not* locked upon return.
163 Optionally, delay "floating_seconds" before broadcasting.
165 $count->broadcast;
167 $count->broadcast( 0.5 );
168 wait
170 Releases a held lock on the variable. Then, waits until another thread
171 does a "signal" or "broadcast" for the same variable. The variable is
172 *not* locked upon return.
173 $count->wait() while $state->get() eq "bar";
175 timedwait ( floating_seconds )
177 Releases a held lock on the variable. Then, waits until another thread
178 does a "signal" or "broadcast" for the same variable or if the timeout
179 exceeds "floating_seconds".
180 A false value is returned if the timeout is reached, and a true value
182 otherwise. In either case, the variable is *not* locked upon return.
183 $count->timedwait( 10 ) while $state->get() eq "foo";
185
187 This module is equipped with sugar methods to not have to call "set"
188 and "get" explicitly. In shared context, the benefit is atomicity and
189 reduction in inter-process communication.
190 The API resembles a subset of the Redis primitives
192 <https://redis.io/commands#strings> without the key argument.
193 append ( value )
195 Appends a value at the end of the current value and returns its new
196 length.
197 $len = $cv->append( "foo" );
199 decr
201 Decrements the value by one and returns its new value.
202 $num = $cv->decr;
204 decrby ( number )
206 Decrements the value by the given number and returns its new value.
207 $num = $cv->decrby( 2 );
209 getdecr
211 Decrements the value by one and returns its old value.
212 $old = $cv->getdecr;
214 getincr
216 Increments the value by one and returns its old value.
217 $old = $cv->getincr;
219 getset ( value )
221 Sets the value and returns its old value.
222 $old = $cv->getset( "baz" );
224 incr
226 Increments the value by one and returns its new value.
227 $num = $cv->incr;
229 incrby ( number )
231 Increments the value by the given number and returns its new value.
232 $num = $cv->incrby( 2 );
234
236 The MCE example <https://github.com/marioroy/mce-
237 examples/tree/master/chameneos> is derived from the chameneos example
238 <http://benchmarksgame.alioth.debian.org/u64q/program.php?test=chameneosredux&lang=perl&id=4>
239 by Jonathan DePeri and Andrew Rodland.
240 use 5.010;
242 use strict;
243 use warnings;
244 use MCE::Hobo;
246 use MCE::Shared;
247 use Time::HiRes 'time';
248 die 'No argument given' if not @ARGV;
250 my $start = time;
252 my %color = ( blue => 1, red => 2, yellow => 4 );
253 my ( @colors, @complement );
255 @colors[values %color] = keys %color;
257 for my $triple (
259 [qw(blue blue blue)],
260 [qw(red red red)],
261 [qw(yellow yellow yellow)],
262 [qw(blue red yellow)],
263 [qw(blue yellow red)],
264 [qw(red blue yellow)],
265 [qw(red yellow blue)],
266 [qw(yellow red blue)],
267 [qw(yellow blue red)],
268 ) {
269 $complement[ $color{$triple->[0]} | $color{$triple->[1]} ] =
270 $color{$triple->[2]};
271 }
272 my @numbers = qw(zero one two three four five six seven eight nine);
274 sub display_complements
276 {
277 for my $i (1, 2, 4) {
278 for my $j (1, 2, 4) {
279 print "$colors[$i] + $colors[$j] -> $colors[ $complement[$i | $j] ]\n";
280 }
281 }
282 print "\n";
283 }
284 sub num2words
286 {
287 join ' ', '', map $numbers[$_], split //, shift;
288 }
289 # Construct condvars and queues first before other shared objects or in
291 # any order when IO::FDPass is installed, used by MCE::Shared::Server.
292 my $meetings = MCE::Shared->condvar();
294 tie my @creatures, 'MCE::Shared';
296 tie my $first, 'MCE::Shared', undef;
297 tie my @met, 'MCE::Shared';
298 tie my @met_self, 'MCE::Shared';
299 sub chameneos
301 {
302 my $id = shift;
303 while (1) {
305 $meetings->lock();
306 unless ($meetings->get()) {
308 $meetings->unlock();
309 last;
310 }
311 if (defined $first) {
313 $creatures[$first] = $creatures[$id] =
314 $complement[$creatures[$first] | $creatures[$id]];
315 $met_self[$first]++ if ($first == $id);
317 $met[$first]++; $met[$id]++;
318 $meetings->decr();
319 $first = undef;
320 # Unlike threads::shared (condvar) which retains the lock
322 # while in the scope, MCE::Shared signal and wait methods
323 # must be called prior to leaving the block, due to lock
324 # being released upon return.
325 $meetings->signal();
327 }
328 else {
329 $first = $id;
330 $meetings->wait(); # ditto ^^
331 }
332 }
333 }
334 sub pall_mall
336 {
337 my $N = shift;
338 @creatures = map $color{$_}, @_;
339 my @threads;
340 print " ", join(" ", @_);
342 $meetings->set($N);
343 for (0 .. $#creatures) {
345 $met[$_] = $met_self[$_] = 0;
346 push @threads, MCE::Hobo->create(\&chameneos, $_);
347 }
348 for (@threads) {
349 $_->join();
350 }
351 $meetings->set(0);
353 for (0 .. $#creatures) {
355 print "\n$met[$_]", num2words($met_self[$_]);
356 $meetings->incrby($met[$_]);
357 }
358 print "\n", num2words($meetings->get()), "\n\n";
360 }
361 display_complements();
363 pall_mall($ARGV[0], qw(blue red yellow));
365 pall_mall($ARGV[0], qw(blue red yellow red yellow blue red yellow red blue));
366 printf "duration: %0.03f\n", time - $start;
368
370 The conditional locking feature is inspired by threads::shared.
371
373 Perl must have IO::FDPass for constructing a shared "condvar" or
374 "queue" while the shared-manager process is running. For platforms
375 where IO::FDPass isn't possible, construct "condvar" and "queue" before
376 other classes. On systems without "IO::FDPass", the manager process is
377 delayed until sharing other classes or started explicitly.
378 use MCE::Shared;
380 my $has_IO_FDPass = $INC{'IO/FDPass.pm'} ? 1 : 0;
382 my $cv = MCE::Shared->condvar();
384 my $que = MCE::Shared->queue();
385 MCE::Shared->start() unless $has_IO_FDPass;
387 Regarding mce_open, "IO::FDPass" is needed for constructing a shared-
389 handle from a non-shared handle not yet available inside the shared-
390 manager process. The workaround is to have the non-shared handle made
391 before the shared-manager is started. Passing a file by reference is
392 fine for the three STD* handles.
393 # The shared-manager knows of \*STDIN, \*STDOUT, \*STDERR.
395 mce_open my $shared_in, "<", \*STDIN; # ok
397 mce_open my $shared_out, ">>", \*STDOUT; # ok
398 mce_open my $shared_err, ">>", \*STDERR; # ok
399 mce_open my $shared_fh1, "<", "/path/to/sequence.fasta"; # ok
400 mce_open my $shared_fh2, ">>", "/path/to/results.log"; # ok
401 mce_open my $shared_fh, ">>", \*NON_SHARED_FH; # requires IO::FDPass
403 The IO::FDPass module is known to work reliably on most platforms.
405 Install 1.1 or later to rid of limitations described above.
406 perl -MIO::FDPass -le "print 'Cheers! Perl has IO::FDPass.'"
408
410 MCE, MCE::Hobo, MCE::Shared
411
413 Mario E. Roy, <marioeroy AT gmail DOT com>
414perl v5.36.0 2023-01-20 MCE::Shared::Condvar(3)