1MCE::Shared::Condvar(3)User Contributed Perl DocumentatioMnCE::Shared::Condvar(3)
2
3
4

NAME

6       MCE::Shared::Condvar - Condvar helper class
7

VERSION

9       This document describes MCE::Shared::Condvar version 1.840
10

DESCRIPTION

12       This helper class for MCE::Shared provides a "Scalar", "Mutex", and
13       primitives for conditional locking.
14

SYNOPSIS

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

EXAMPLE

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

API DOCUMENTATION

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

SUGAR METHODS

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

CHAMENEOS DEMONSTRATION

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

CREDITS

368       The conditional locking feature is inspired by threads::shared.
369

LIMITATIONS

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

INDEX

408       MCE, MCE::Hobo, MCE::Shared
409

AUTHOR

411       Mario E. Roy, <marioeroy AT gmail DOT com>
412
413
414
415perl v5.28.1                      2019-01-04           MCE::Shared::Condvar(3)
Impressum