The following code allows the main thread to pick a thread, set a value into a shared scalar for that particular thread, and then signal it and have the chosen thread collect it:
#! perl -slw use strict; use threads qw[ yield ]; use threads::shared; sub thread { my $tid = threads->tid; my $refSem = shift; while( 1 ) { warn( "$tid:locking sem\n" ); lock( $$refSem ); warn( "$tid:waiting sem\n" ); cond_wait( $$refSem ); print "$tid: got $$refSem"; warn( "$tid:yielding\n" ); yield; warn( "$tid:looping\n" ); } } my $sem1 :shared; my $thread1 = threads->create( \&thread, \$sem1 ); my $sem2 :shared; my $thread2 = threads->create( \&thread, \$sem2 ); while( sleep 1 ) { my $value = int( rand 1000 ); my $thread = 1 + int rand( 2 ); my $refSem = $thread == 1 ? \$sem1 :\$sem2; warn( "0:locking sem for thread $thread\n" ); lock( $$refSem ); warn( "0:Setting sem$thread to $value\n" ); $$refSem = $value; warn( "0:signalling sem$thread\n" ); cond_signal( $refSem ); warn( "0:Sleeping\n" ); } __END__ C:\test>t-cond.pl 1:locking sem 1:waiting sem 2:locking sem 2:waiting sem 0:locking sem for thread 1 0:Setting sem1 to 738 0:signalling sem1 0:Sleeping 1: got 738 1:yielding 1:looping 1:locking sem 1:waiting sem 0:locking sem for thread 2 0:Setting sem2 to 845 0:signalling sem2 0:Sleeping 2: got 845 2:yielding 2:looping 2:locking sem 2:waiting sem 0:locking sem for thread 2 0:Setting sem2 to 524 0:signalling sem2 0:Sleeping 2: got 524 2:yielding 2:looping 2:locking sem 2:waiting sem
The problem is how to extend that to an arbitrary number of threads. Using individually shared scalars obviously isn't going to work.
Your first instinct (like mine) is probably to use a shared array. The problem with that is that any attempt to lock or signal an element of a shared array results in lock can only be used on shared values:
#! perl -slw use strict; use threads qw[ yield ]; use threads::shared; sub thread { my $tid = threads->tid; my $refSem = shift; while( 1 ) { warn( "$tid:locking sem\n" ); lock( $$refSem ); warn( "$tid:waiting sem\n" ); cond_wait( $$refSem ); print "$tid: got $$refSem"; warn( "$tid:yielding\n" ); yield; warn( "$tid:looping\n" ); } } our $T ||= 2; my @sems :shared = 0 .. $T; my @threads = map{ threads->create( \&thread, \$sems[ $_ ] ); } 1 .. $T; while( sleep 1 ) { my $value = int( rand 1000 ); my $thread = 1 + int rand( 2 ); my $refSem = \$sems[ $thread ]; warn( "0:locking sem for thread $thread\n" ); lock( $$refSem ); warn( "0:Setting sem$thread to $value\n" ); $$refSem = $value; warn( "0:signalling sem$thread\n" ); cond_signal( $refSem ); warn( "0:Sleeping\n" ); } __END__ C:\test>t-cond-2.pl 1:locking sem Thread 1 terminated abnormally: lock can only be used on shared values + at C:\test\t-cond-2.pl line 11. 2:locking sem Thread 2 terminated abnormally: lock can only be used on shared values + at C:\test\t-cond-2.pl line 11. 0:locking sem for thread 1 lock can only be used on shared values at C:\test\t-cond-2.pl line 34. Perl exited with active threads: 0 running and unjoined 2 finished and unjoined 0 running and detached
Any takers?
In reply to How to create a collection of shared scalars suitable for locking and signalling? by BrowserUk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |