Metered concurrency: Difference between revisions
Content deleted Content added
No edit summary |
→Tcl: Added implementation |
||
Line 472: | Line 472: | ||
Thread joining is automatic by default. |
Thread joining is automatic by default. |
||
=={{header|Tcl}}== |
|||
Uses the Thread package, which is expected to form part of the overall Tcl 8.6 release. |
|||
<lang tcl>package require Thread |
|||
# Create the global shared state of the semaphore |
|||
set handle semaphore0 |
|||
tsv::set $handle mutex [thread::mutex create] |
|||
tsv::set $handle cv [thread::cond create] |
|||
tsv::set $handle count 0 |
|||
tsv::set $handle max 3 |
|||
# Make five worker tasks |
|||
for {set i 0} {$i<5} {incr i} { |
|||
lappend threads [thread::create -preserved { |
|||
# Not bothering to wrap this in an object for demonstration |
|||
proc init {handle} { |
|||
global mutex cv count max |
|||
set mutex [tsv::object $handle mutex] |
|||
set cv [tsv::object $handle cv] |
|||
set count [tsv::object $handle count] |
|||
set max [tsv::get $handle max] |
|||
} |
|||
proc acquire {} { |
|||
global mutex cv count max |
|||
thread::mutex lock [$mutex get] |
|||
while {[$count get] >= $max} { |
|||
thread::cond wait [$cv get] [$mutex get] |
|||
} |
|||
$count incr |
|||
thread::mutex unlock [$mutex get] |
|||
} |
|||
proc release {} { |
|||
global mutex cv count max |
|||
thread::mutex lock [$mutex get] |
|||
if {[$count get] > 0} { |
|||
$count incr -1 |
|||
thread::cond notify [$cv get] |
|||
} |
|||
thread::mutex unlock [$mutex get] |
|||
} |
|||
# The core task of the worker |
|||
proc run {handle id} { |
|||
init $handle |
|||
acquire |
|||
puts "worker $id has acquired the lock" |
|||
after 2000 |
|||
release |
|||
puts "worker $id is done" |
|||
} |
|||
# Wait for further instructions from the main thread |
|||
thread::wait |
|||
}] |
|||
} |
|||
# Start the workers doing useful work, giving each a unique id for pretty printing |
|||
set i 0 |
|||
foreach t $threads { |
|||
puts "starting thread [incr i]" |
|||
thread::send -async $t [list run $handle $i] |
|||
} |
|||
# Wait for all the workers to finish |
|||
foreach t $threads { |
|||
thread::release -wait $t |
|||
}</lang> |
|||
=={{header|UnixPipes}}== |
=={{header|UnixPipes}}== |
||
Line 495: | Line 563: | ||
echo 'Initialize Jobs' >&2 ; echo '1' > sem |
echo 'Initialize Jobs' >&2 ; echo '1' > sem |
||
=={{header|Visual Basic .NET}}== |
=={{header|Visual Basic .NET}}== |