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

I''m trying to implement a baton passing mechanism using threads::shared, and either I am misunderstanding the semantics of the locking and signalling primitives or it would not seem possible to reliably implement this using them.

The mechanism is analogous to the passing of the baton in a relay race. There is a single shared scalar, and each thread blocks on that scalar until it signalled and contains that threads id.

The identified thread then has the baton, and does whatever it does until it sets the id of some other thread into the baton variable, signals it, and then goes back to waiting.

This is how I think it should be coded. 

use strict;
use warnings;
use Time::HiRes 'sleep';
use threads;
use threads::shared;

my $baton:shared = 0;

sub sprinter {
    my ($no_of_threads,$sleep) = @_;
    my $id = threads->self->tid;
    warn ("Thread $id started\n");
    while (1) {
        lock ($baton);
        cond_wait ($baton) until $baton == $id;
        warn ("Thread $id has the baton\n");
        sleep ($sleep);
        $baton = int (rand ($no_of_threads)) until $baton != $id;
        warn ("Thread $id passing the baton to thread $baton\n");
        cond_signal ($baton);
#        cond_broadcast ($baton);
    }
}


my ($no_of_sprinters, $sleep ) = @ARGV;
$no_of_sprinters ||= 3;

my @threads;
push @threads,threads->new (\&sprinter,$no_of_sprinters, $sleep)
    for 1..$no_of_sprinters;

sleep 1;
while(1){
    lock ($baton);
    cond_wait ($baton) until $baton == 0;
    warn ("Thread 0 has the baton\n");
    sleep ($sleep);
    $baton = int (rand ($no_of_sprinters)) until $baton != 0;
    warn ("Thread 0 passing the baton to thread $baton\n");
    cond_signal ($baton);
#    cond_broadcast ($baton);
}

[download]

If you run this a few times, it will sometimes never pass the baton. Sometimes pass it few times and then hang.

It never seems to pass the baton more that the number of threads specified, though it will sometimes successfully pass it to the same thread two or more times before stopping.

I have found what appears to be a reliable cure (with a caveat). If you switch from using cond_signal to cond_broadcast, with no other changes it seems to run reliably for as long as you choose to leave it.

The question is, why is it necessary to use cond_broadcast? Or, what changes are required to make the cond_signal version work?

The caveat I mentioned is that whilst you can reduce the sleep value to 0.0, if you comment out the sleeps entirely, even the cond_broadcast version hangs almost at once?

This may be something to do with the note in the pod that says <cite> If there are no threads blocked in a cond_wait on the variable, the signal is discarded. By always locking before signaling, you can (with care), avoid signaling before another thread has entered cond_wait(). </cite>

I am always locking before signalling, so what extra "care" do I need to take?

Replies are listed 'Best First'.
Re: baton passing threads and cond_signal
by ikegami (Patriarch) on Aug 21, 2007 at 20:00 UTC

    cond_signal wakes an arbitrary thread that's waiting on the argument, not the thread specified by the argument.

    If you wanted to use cond_signal, you'd have to replace 

            cond_wait ($baton) until $baton == $id;

    [download]

    with 

            for (;;) {
           cond_wait ($baton);
           last if $baton == $id;
           # This isn't the right sprinter, so try another.
           cond_signal ($baton);
        }

    [download]

    I don't know which approach is better.

[reply]
[d/l]
[select]
Re: baton passing threads and cond_signal
by Joost (Canon) on Aug 21, 2007 at 19:27 UTC
    At first glance it appears that you should indeed use cond_broadcast() since you're cond_wait()ing on the baton from multiple threads, but you only want one, specific thread to pick it up. From the docs (emphasis mine):
    The "cond_signal" function takes a locked variable as a parameter and unblocks one thread that’s "cond_wait"ing on that variable. If more than one thread is blocked in a "cond_wait" on that variable, only one (and which one is indeterminate) will be unblocked.

    ...

    The "cond_broadcast" function works similarly to "cond_signal". "cond_broadcast", though, will unblock all the threads that are blocked in a "cond_wait" on the locked variable, rather than only one.

    update: I overlooked your caveat
    The caveat I mentioned is that whilst you can reduce the sleep value to 0.0, if you comment out the sleeps entirely, even the cond_broadcast version hangs almost at once?

    If I replace both cond_signal()s with cond_broadcast()s, it works fine, even with all the sleep()s removed completely.

    You do still have a problem in that: 

     $baton = int (rand ($no_of_threads)) until $baton != $id;

    [download]
    Could theoretically take a very long time. and 

    $baton = int (rand ($no_of_sprinters)) until $baton != 0;

    [download]
    Never assigns the baton to thread number $no_of_sprinters (i.e. it won't work with only 1 sprinter)

    Use: 

    $baton = int (rand ($no_of_sprinters)) + 1;

    [download]
    Since rand($number) always returns a number LESS THAN $number

    "What should it profit a man, if he should win a flame war, yet lose his cool?"
[reply]
[d/l]
[select]

      Thanks. That clears up the cond_signal thing, but regarding the caveat and your update.

      With the following code, which I think incorporates all your changes,if I leave the sleep in, or as show, replace it by yield, any number of threads appear to run reliably.

      But if I comment out the yields, it locks up almost straight away. Do you get a different result?

      I'm running this on a single processor. Are you using a multi? 

      use strict;
use warnings;
use Time::HiRes 'sleep';
use threads 'yield';
use threads::shared;

my $baton:shared = 0;

sub sprinter {
    my ($no_of_threads,$sleep) = @_;
    my $id = threads->self->tid;
    warn ("Thread $id started\n");
    while (1) {
        lock ($baton);
        cond_wait ($baton) until $baton == $id;
        warn ("Thread $id has the baton\n");
#        yield;
        $baton = int (rand ($no_of_threads)) until $baton != $id;
        warn ("Thread $id passing the baton to thread $baton\n");
        cond_broadcast ($baton);
    }
}

my ($no_of_sprinters) = @ARGV;
$no_of_sprinters ||= 3;

my @threads;
push @threads,threads->new (\&sprinter,$no_of_sprinters)
    for 1..$no_of_sprinters;

sleep 1;
while(1){
    lock ($baton);
    cond_wait ($baton) until $baton == 0;
    warn ("Thread 0 has the baton\n");
#    yield;
    $baton = int (rand ($no_of_sprinters))+1 until $baton != 0;
    warn ("Thread 0 passing the baton to thread $baton\n");
    cond_broadcast ($baton);
}

      [download]
[reply]
[d/l]
        As you posted it, the code works fine for me.

        When using threads (as when using unicode or the other fairly recent additions to perl) you should probably run the latest (stable) version of perl and the relevant modules.

        I'm running perl 5.8.8 on debian linux, with threads version 1.62 (a few months old) and threads::shared version 1.12 (that's the current version) - note: the threads modules included in the standard perl 5.8.8 distribution are much older than that.

        update: yes I'm running this on a core-2 duo intel machine (32 bit linux), so that would work like a multi-processor machine.

        "What should it profit a man, if he should win a flame war, yet lose his cool?"
[reply]

Back to Seekers of Perl Wisdom