Posted to tcl by aspect at Thu Apr 27 02:44:29 GMT 2017view pretty

package require Thread

set unfinished_work {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
set finished_work   {}
set workers         {}
set retirees        {}
set n_workers       7
set is_done         false

set USE_PRESERVE 0      ;# MUST MATCH

set worker_script {

    set USE_PRESERVE 0      ;# MUST MATCH

    proc work {main} {
        set result 0
        while 1 {
            puts "[thread::id] asking for work"

            set work [thread::send $main get_work]
            if {$work eq ""} break

            puts "[thread::id] doing $work"
            after 1
            thread::send -async $main [list give_result [thread::id] $work]
        }
        puts "[thread::id] done!"
        thread::send -async $main [list remove_worker [thread::id]]
        if {$::USE_PRESERVE} {
            thread::release
        } else {
            thread::exit
        }
    }

    thread::wait
}

proc get_work {} {
    puts "Main distributing work from {$::unfinished_work}"
    set ::unfinished_work [lassign $::unfinished_work work]
    return $work
}

proc give_result {wid result} {
    puts "Main receiving finished work: $result"
    lappend ::finished_work $result
}

proc remove_worker {wid} {
    puts "Main removing $wid"
    set status [thread::join $wid]
    puts "Main removed $wid: $status"
    if {[dict unset ::workers $wid] eq ""} {
        puts "Main done!"
        set ::is_done true
    }
}

proc start_worker {} {
    if {$::USE_PRESERVE} {
        set id [thread::create -preserved -joinable $::worker_script]
    } else {
        set id [thread::create -joinable $::worker_script]
    }
    dict set ::workers $id working
    thread::send -async $id [list work [thread::id]]
    return $id
}


for {set i 0} {$i < $::n_workers} {incr i} {
    set wid [start_worker]
    puts "Started worker: $wid"
}
vwait is_done

puts "Results: $::finished_work"
puts "Remaining threads: [thread::names]"