See http://shootout.alioth.debian.org/gp4/benchmark.php?test=threadring&lang=all


----
[jmn]
I tried the following, but it errors out with "can't create a new thread" - even though my system appears to have plenty of free memory.

Any ideas as to what limit I'm hitting? 

''[escargo] 4 Jun 2008'' - Well, how about telling us what version of Tcl and system you are using,
plus a description of its hardware resources?

[jmn] Tcl 8.5.2b1 - Vista x64 - core2 2.4Ghz 4G ram 

It seems to produce the error for ring_size >= 206

 - also, due to the above error, I haven't verified that the code below produces the right result. 
If anyone else runs it sucessfully, please make a note here as to whether it produces the expected result for N = 1000, of 498;  thanks.

[SL] I can create up to ~800 threads. I guess to run this script in the same shell multiple times you have to release some threads.
%|N|result|secs|system|%
|1000|498|2.46|Tcl 8.5.2 - XP x86 core2 2.0GHz|
|10,000,000|361|336.51|Tcl 8.5.2 - XP x86 core2 2.0GHz|

[jmn] Thanks for that. A little disappointing given your machine seems similar but a little more powerful than the actual machines used for the benchmark - but still seems not too bad.

Ahh well, if we can't beat them on performance - we can still be right up there for gzip bytes & linecount.. see v2 for a more compact version.


[jmn] 2008-06-12  
I had another stab at it.. this time using a thread shared variable to hold the token, and a condition variable per thread to wait upon.

This is much faster than versions 1 & 2

It has a rather ugly hack though..   'after 5' where I burn a few milliseconds to make sure the 1st thread is ready to be notified.

using: Tcl 8.6a0 - Vista x64 core2 2.4GHZ
%|Ver|N|result|secs|system|%
|1|1000|498|1.42|
|1|10,000,000|361|325.28|
|3|1000|498|1.30|
|3|10,000,000|361|103.95|


----

V1
======
 set ring_size 503
 set N 1000
 package require Thread
 proc done {} {
 	set ::done 1
 }
 set script {
 	proc accept {t} {
 		if {$t == 0} {
 			puts stdout "%i%"
 			thread::send -async %m% done
 			return
 		}
 		thread::send -async %n% [list accept [expr {$t - 1}] ]
 	}
 	%do%
 }
 set t1 [set tnext [thread::create {thread::wait}]]
 for {set i $ring_size} {$i >1} {incr i -1} {
  	set tnext [thread::create [string map [list %m% [thread::id] %i% $i %n% $tnext %do% "thread::wait"] $script]]
 }
 #close the ring
 set script [string map [list %m% [thread::id] %i% 1 %n% $tnext %do% [list accept $N]] $script]
 thread::send -async $t1 $script
 vwait ::done 
======

v2  (slightly slower)
======

 package require Thread
 set ring_size 503
 set N 1000
 set script { 
	interp alias {} accept0 {} thread::send -async %m% "set ::done %i%"
 	interp alias {} accept1 {} apply {t {thread::send -async %n% "accept[expr {$t>1?1:0}] [expr {$t-1}]"}}
 	%do%
 }
 set t1 [set tnext [thread::create {thread::wait}]]
 for {set i $ring_size} {$i >1} {incr i -1} {
 	set tnext [thread::create [string map "%m% [thread::id] %i% $i %n% $tnext %do% thread::wait" $script]]
 }
 thread::send -async $t1 [string map "%m% [thread::id] %i% 1 %n% $tnext %do% {accept1 $N}" $script]
 vwait ::done
 puts stdout $::done

======
v3  

======

 set ring_size 503
 set N 10000000
 package require Thread
 set script {
 	proc run {} {
 		set t -2
 		thread::mutex lock %m%
 		while {$t != -1} {
 			thread::cond wait %c% %m%
 			set t [tsv::incr TOK t -1]
 			thread::cond notify %cnext%
 		}
 		thread::mutex unlock %m%
 		puts stdout "%i%"
 		thread::send -async %main% {set ::done 1}
 		thread::cond destroy %c%
 		return
 	}
 	%do%
 }
 set t1 [set tnext [thread::create {thread::wait}]]
 set c1 [set c [thread::cond create]]
 set m [thread::mutex create]
 for {set i $ring_size} {$i >1} {incr i -1} {
 	set cnext $c
 	set c [thread::cond create]
 	set tnext [thread::create [string map [list %main% [thread::id] %i% $i %m% $m %c% $c %cnext% $cnext %n% $tnext %do% run] $script]]
 }
 #close the ring
 set script [string map [list %main% [thread::id] %i% 1 %m% $m %c% $c1 %cnext% $c %n% $tnext %do% "thread::send -async [thread::id] {set ::start 1};run"] $script]
 thread::send -async $t1 $script
 vwait ::start
 after 5
 tsv::set TOK t $N
 thread::cond notify $c1
 vwait ::done 

======

----
!!!!!!
%| [Category Performance] |%
!!!!!!