#! perl -slw
use strict;
use threads qw[ yield ];
use threads::shared;

$| = 1;
our $N ||= 10;
our $YIELD ||= 0;

my $signal : shared;

sub busywork{
	my( $counterRef ) = @_;
	my $self = threads->self->tid();
	warn join ' : ', $self, time(), 'waiting';
	
	{ ## Wait until the main thread signals the start.
		my $lock : shared;
		lock( $lock );
		cond_wait( $signal, $lock ); 
	}
	warn join ' : ', $self, time(), 'starting';

	for( 1 .. 1_000_000 ) {
		$$counterRef++;
		$YIELD and yield unless $$counterRef % 10000;
	}
	warn join ' : ', $self, time(), 'ending';
	return 0;
}

my @counters : shared = ( 0 ) x $N;
my @threads;

{
	lock( $signal );

	@threads = map{ threads->new( 
		\&busywork, \$counters[ $_ ], \$signal ) 
	} 0..$#counters;
	
	sleep 2; ## Give all threads teh chance to reach their starting blocks
	cond_broadcast( $signal ); ## Go
}

## (Crudely) track their progress.
## Remember that the main thread can't run while one of them is.

print "@counters" and yield 
	until $_ = grep{ $_ == 1_000_000 } @counters and defined $_ and $_ = 10;

$_->join for @threads;

__END__
## Note: the YIELD parameter was not set for this run.
P:\test>355678 
1 : 1085288999 : waiting at P:\test\355678.pl line 14.
2 : 1085288999 : waiting at P:\test\355678.pl line 14.
3 : 1085288999 : waiting at P:\test\355678.pl line 14.
4 : 1085288999 : waiting at P:\test\355678.pl line 14.
5 : 1085288999 : waiting at P:\test\355678.pl line 14.
6 : 1085289000 : waiting at P:\test\355678.pl line 14.
7 : 1085289000 : waiting at P:\test\355678.pl line 14.
8 : 1085289000 : waiting at P:\test\355678.pl line 14.
9 : 1085289000 : waiting at P:\test\355678.pl line 14.
10 : 1085289000 : waiting at P:\test\355678.pl line 14.
1 : 1085289002 : starting at P:\test\355678.pl line 21.
2 : 1085289002 : starting at P:\test\355678.pl line 21.
3 : 1085289002 : starting at P:\test\355678.pl line 21.
5 : 1085289002 : starting at P:\test\355678.pl line 21.
29310 140122 27149 0 140702 0 0 0 0 0
29310 176283 27149 0 195750 0 0 0 0 0
84864 359152 27149 0 287224 0 0 0 0 0
10 : 1085289007 : starting at P:\test\355678.pl line 21.
251391 505324 27149 0 360969 0 0 0 0 72076
251391 523617 27149 0 397718 0 0 0 0 72076
343531 578503 27149 0 488759 0 0 0 0 108175
9 : 1085289011 : starting at P:\test\355678.pl line 21.
8 : 1085289011 : starting at P:\test\355678.pl line 21.
7 : 1085289011 : starting at P:\test\355678.pl line 21.
6 : 1085289012 : starting at P:\test\355678.pl line 21.
4 : 1085289014 : starting at P:\test\355678.pl line 21.
454183 651559 81842 72782 506960 53176 311778 180260 89695 162442
454183 651559 191284 236696 506960 301616 421759 180260 89695 162442
454183 651559 263785 437109 506960 319448 421759 180260 89695 162442
454183 651559 300162 453059 506960 319448 421759 180260 89695 162442
454183 651559 300162 453059 542064 319448 421759 180260 89695 162442
454183 688084 300162 453059 596870 319448 421759 180260 89695 162442
454183 834344 300162 453059 651630 319448 421759 180260 89695 162442
454183 852653 300162 453059 706771 319448 421759 180260 89695 162442
7 : 1085289031 : ending at P:\test\355678.pl line 26.
2 : 1085289037 : ending at P:\test\355678.pl line 26.
9 : 1085289041 : ending at P:\test\355678.pl line 26.
1 : 1085289046 : ending at P:\test\355678.pl line 26.
5 : 1085289046 : ending at P:\test\355678.pl line 26.
8 : 1085289048 : ending at P:\test\355678.pl line 26.
6 : 1085289052 : ending at P:\test\355678.pl line 26.
4 : 1085289053 : ending at P:\test\355678.pl line 26.
10 : 1085289053 : ending at P:\test\355678.pl line 26.
3 : 1085289053 : ending at P:\test\355678.pl line 26.