BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

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?


Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Replies are listed 'Best First'.
Re: How to create a collection of shared scalars suitable for locking and signalling?
by JadeNB (Chaplain) on Dec 03, 2008 at 00:10 UTC
    My perl's not compiled with thread-support, so I can't test this; but couldn't you just move the initialisation code
    my $sem :shared; my $thread1 = threads->create( \&thread, \$sem );
    inside a for loop, and use that to populate an array?

      Tested. Works. Changed lines are marked.

      #! perl -slw use strict; use threads qw[ yield ]; use threads::shared; use constant NUM_THREADS => 2; # <-- 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 @workers; # <-- for (1..NUM_THREADS) { # <-- my $sem :shared; # <-- my $thread = threads->create( \&thread, \$sem ); # <-- push @workers, [ $thread, \$sem ]; # <-- } # <-- while( sleep 1 ) { my $value = int( rand 1000 ); my $thread = int rand( @workers ); # <-- my $refSem = $workers[$thread][1]; # <-- 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" ); }

      I stored $thread in the array it was being stored saved in the original too. It's not being used by the program as is, though. Storing just the sem refs is fine too.

      Yes that works. Unintuatively, an unshared array of references to shared scalars does the trick:

      #! 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 = map{ my $var :shared; \$var } 0 .. $T; my @threads = map{ threads->create( \&thread, $sems[ $_ ] ); } 1 .. $T; while( 1 ) { my $value = int( rand 1000 ); my $thread = 1 + int rand( $T ); 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" ); yield; }

      Shame there isn't a less clumsy way to allocate an array of shared scalars than:

      my @sems = map{ my $var :shared; \$var } 0 .. $T;

      It's also high time that the "documented limitation" (BUG!):

      share() allows you to share($hashref->{key}) without giving any error message. But the $hashref->{key} is not shared, causing the error "locking can only be used on shared values" to occur when you attempt to lock($hasref->{key}).

      that also affects array elements was fixed.


      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.