CODEWITHSUNDEEP
multithreadingtcl
YANPENG YIN
YANPENG YIN

Reputation: 51

how to start multi-thead using a loop rightly in TCL?

I want to get 200 files using multithread, so I modify a TCL example as below. But the result is strange, the total number of output files is random, about 135. I was confused that how the thread started change the value of variable $thread.

package require Thread
puts "*** I'm thread [thread::id]"

for {set thread 1} {$thread <= 200} {incr thread} {
    set thread_ida $thread
    tsv::set app global_thread_num $thread_ida

    set id [thread::create -joinable {

        puts [ tsv::get app global_thread_num ]
        set thread_id [ tsv::get app global_thread_num ]
        puts "${thread_id}thread_id"
        set outFile "./test/${thread_id}"
        append outFile ".tmd"
        puts $outFile
        set FileOut [open $outFile w+]
        puts $FileOut "${thread_id}thread_id"
    }] ;# thread::create
    puts "*** Started thread $id"
    lappend threadIds $id
} ;# for
puts "*** Existing threads: [thread::names]"
# Wait until all other threads are finished
foreach id $threadIds {
    thread::join $id
}
puts "*** That's all, folks!"

Upvotes: 0

Views: 327

Answers (1)

Donal Fellows
Donal Fellows

Reputation: 137557

The problem you've got is that these two lines:

puts [ tsv::get app global_thread_num ]
set thread_id [ tsv::get app global_thread_num ]

are not guaranteed to get the same value at all, nor are they at all likely to synchronise with the setting of the shared variable in the outer loop. Threads in Tcl have a reasonable amount of overhead during launch.

Instead, what you should do is make threads with the description of work inside a procedure and then send a simple message to them with the ID to start the real processing; that's much easier to make work.

package require Thread
puts "*** I'm thread [thread::id]"

for {set thread 1} {$thread <= 200} {incr thread} {
    set id [thread::create -joinable {
        proc DoWork {thread_id} {
            # Only one puts here
            puts "${thread_id}thread_id"
            set outFile "./test/${thread_id}"
            append outFile ".tmd"
            puts $outFile
            set FileOut [open $outFile w+]
            puts $FileOut "${thread_id}thread_id"
            # Close the channel, please...
            close $FileOut
            # Thread done, and since we're using joinable threads it should die now
            thread::release
        }
        thread::wait
    }] ;# thread::create
    puts "*** Started thread $id"
    lappend threadIds $id
    # Start the work going, passing over the numeric ID in the "message"
    thread::send -async $id [list DoWork $thread]
} ;# for
puts "*** Existing threads: [thread::names]"
# Wait until all other threads are finished
foreach id $threadIds {
    thread::join $id
}
puts "*** That's all, folks!"

The key things here are that we create a procedure in each thread (DoWork) to receive the message, get the thread to wait for messages with thread::wait, and then launch the work by sending a message in with thread::send -async. The work destroys the thread with thread::release; it needs to do so explicitly otherwise it'll end up back in thread::wait waiting for the next message.

I'd probably use a thread pool in production code, as they're easier to scale to the hardware available in a particular deployment. The DoWork procedure — without the thread::release — would be defined in the pool's -initcmd option. The thread::send -async would be replaced by posting work to the pool, and you'd be waiting for the jobs instead of the threads.

package require Thread
puts "*** I'm thread [thread::id]"

set pool [tpool::create -maxworkers 48 -initcmd {
    proc DoWork {thread_id} {
        # Only one puts here
        puts "${thread_id}thread_id"
        set outFile "./test/${thread_id}"
        append outFile ".tmd"
        puts $outFile
        set FileOut [open $outFile w+]
        puts $FileOut "${thread_id}thread_id"
        # Close the channel, please...
        close $FileOut
    }    
}]

for {set thread 1} {$thread <= 200} {incr thread} {
    lappend work [tpool::post -nowait $pool [list DoWork $thread]]
}
# Wait until all work is finished
foreach id $work {
    tpool::wait $pool $id
}
puts "*** That's all, folks!"
tpool::release $pool

Upvotes: 2

Related Questions