Proper ways to use threads in TCL - multithreading

So I have the following code -
#!/usr/bin/env tclsh
package require Thread
thread::create {
for {set i 0} {$i < 1000} {incr i} {
puts "hello T1 $i"
}
thread::wait
}
thread::create {
for {set j 0} {$j < 1000} {incr j} {
puts "hello T2 $j"
}
thread::wait
}
It runs, but the first thread run more iterations than the loop count (1000) and the second thread has far fewer iterations than its loop count (1000 ). Can someone point out what's wrong with this code? Many thanks for your help.

Related

How to get back the finished runs of multithreading tcl?

I'm running simultaneously thoses 2 counters:
package require Thread
set TID1 [thread::create -joinable {
proc DATE {} {clock format [clock scan [exec date]] -format {%m%b%y-%H:%M:%S}}
puts "start T1-: [DATE]"
for {set i 0} {$i < 3} {incr i} {
exec sleep 1
puts "run T1 $i"
}
puts "end T1---: [DATE]"
}]
set TID2 [thread::create -joinable {
proc DATE {} {clock format [clock scan [exec date]] -format {%m%b%y-%H:%M:%S}}
puts "start T2-: [DATE]"
for {set j 0} {$j < 5} {incr j} {
exec sleep 1
puts "run T2 $j"
}
puts "end T2---: [DATE]"
}]
The results are:
% tid0x2aeab8e06700
% tid0x2aeab8c05700
% % % % start T2-: 09Sep21-16:03:27
start T1-: 09Sep21-16:03:27
run T2 0
run T1 0
run T2 1
run T1 1
run T2 2
run T1 2
end T1---: 09Sep21-16:03:30
run T2 3
run T2 4
end T2---: 09Sep21-16:03:32
How to catch the first finished run (which is T2) and to display it ?,
it doesnt work using the following code:
foreach TID {$TID1 $TID2} {
set FID [thread::join $TID]
puts "treads finished => $FID"
}
Remember that Rule 8 says in part
Variable substitution is not performed on words enclosed in braces.
You need something that will do variable substitution when creating the list that foreach iterates over, like
foreach TID [list $TID1 $TID2] {
set FID [thread::join $TID]
puts "thread finished => $FID"
}

TCL: thread::send command is running in main thread instead of thread id mentioned in send command

Below is the example script written for implementing multi threading for my existing single (main thread) threaded scripts.
# Wrapper proc for executing passed procedure list
proc eval_procs {dut_no procList} {
telnet_dut $dut_no ;# proc to change telnet id to $dut_no
puts "thread id: [thread::id]"
foreach procedure [join [list $procList]] {
eval [join $procedure]
}
}
for {set i 0} {$i <= 1} {incr i} {
lappend jointhreadIds [thread::create]
}
set dutList [list 1 2]
set dutConfigList [list [list "get_port_statistics_mt 1"] [list "c_get_port_statistics_mt 2"]] ;#proc for getting port statistics from switch 1 and 2
for {set i 0} {$i <= 1} {incr i} {
thread::send -async [lindex $jointhreadIds $i] [eval_procs [lindex $dutList $i] [lindex $dutConfigList $i]]
}
Two threads are created for calling the same proc (eval_procs) for each switch. But, when the proc is called using the thread::send -async, this proc is called sequentially for switch1 and later for switch2. After printing thread::id in eval_procs, I found that these procs are running in main thread, which is the reason for sequential run.
Any one to help me here, what mistake I am doing here or any other procedure to follow ?
The below post mentions to define the procs in the script while creating thread, but for me I have so many already developed libraries (procs) which are working fine with main thread. So, I can not move all the libraries under the thread::create.
https://stackoverflow.com/a/32154589/13100284
In general, any custom procedures (or C commands) you create in your master interpreter are not also created in the interpreters of other threads. You can use the ttrace system of the Thread package to do the replication, but you'll need to explicitly load any extra C commands you need. (I prefer to just put everything required in packages and then just package require in every worker thread as required, but that's more complex.)
package require Ttrace
# Procedures created in here get replicated to current and future threads
ttrace::eval {
# Wrapper proc for executing passed procedure list
proc eval_procs {dut_no procList} {
telnet_dut $dut_no ;# proc to change telnet id to $dut_no
puts "thread id: [thread::id]"
foreach procedure [join [list $procList]] {
eval [join $procedure]
}
}
# You probably need to create the other commands here; I don't know your code, but you can source them just fine
}
# Now, the rest of your code as normal.
for {set i 0} {$i <= 1} {incr i} {
lappend jointhreadIds [thread::create]
}
set dutList [list 1 2]
set dutConfigList [list [list "get_port_statistics_mt 1"] [list "c_get_port_statistics_mt 2"]]; #proc for getting port statistics from switch 1 and 2
for {set i 0} {$i <= 1} {incr i} {
thread::send -async [lindex $jointhreadIds $i] [eval_procs [lindex $dutList $i] [lindex $dutConfigList $i]]
}
Note that you probably have other bugs too. And that last command offends me, as it should be using a multi-list foreach and building the command to go to to the other thread with list. Here, I mean it should be something like this:
foreach t_id $joinThreadIds dut_no $dutList dut_config $dutConfigList {
# I've split the next line in two for even more clarity
thread::send -async $t_id [list \
eval_procs $dut_no $dut_config]
}
You are executing eval_procs in the current thread and sending the result to the threads to execute. Since eval_procs returns the empty string, the threads effectively do nothing.
You probably want an additional list in there:
thread::send -async [lindex $jointhreadIds $i] \
[list eval_procs [lindex $dutList $i] [lindex $dutConfigList $i]]
But that will fail, because the eval_procs command is not known in the worker threads. You will have to define that proc in each of the subthreads, rather than in the current one.

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!"
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

Please help me with the simple tcl code

It is a simple code which gives the output when a number is raised to another number.But it is always returning the square of the number and not looping.
Please help guys
#!/usr/bin/tclsh
proc raise {{base} {pow} args} {
for {set base1 $base} {$pow >= 0} {incr $pow -1} {
set ans [expr $base * $base1 ]
set base $ans
return $ans
}
}
You are allowing the loop to go through at most 1 iteration. This is because return quits the current proc (the loop as well automatically).
Fixing that part would give:
#!/usr/bin/tclsh
proc raise {{base} {pow} args} {
for {set base1 $base} {$pow >= 0} {incr $pow -1} {
set ans [expr $base * $base1 ]
set base $ans
}
return $ans
}
But.. that doesn't quite give you the answer, does it. The logic of your code is not quite correct. I think it should be:
proc raise {base pow} {
for {set base1 $base} {$pow > 1} {incr pow -1} {
set ans [expr {$base * $base1}]
set base $ans
}
return $ans
}
incr takes a variable name, not a variable, and you want to iterate until the power is above 1. If it is 1, then you get the base, hence you don't loop. The last change was to brace the expressions. To make the above work for powers of 0 as well, you can use Peter's proc.
But all that said, why don't you use the inbuilt operator for this?
set ans [expr {$base**$pow}]
or even:
set ans [expr {pow($base,$pow)}]
A slightly less messy solution which gives a correct answer for $pow = 0 too:
proc raise {base pow} {
for {set answer 1} {$pow > 0} {incr pow -1} {
set answer [expr {$answer * $base}]
}
return $answer
}
It's often useful, when experimenting with code, to be stingy with variables and command invocations: when you're sure that you can't eliminate any more of them, you probably have fairly efficient, readable, and robust code.
Documentation: expr, for, incr, proc, return, set
just a first-glance-answer: don't you return too early?
#!/usr/bin/tclsh
proc raise {{base} {pow} args} {
for {set base1 $base} {$pow >= 0} {incr $pow -1} {
set ans [expr $base * $base1 ]
set base $ans
}
return $ans
}

Tcl: strange behavior of string list

In my following code, I generate a string list in a for loop like this:
set section 5;
set value 2;
set value_range_new "";
for { set i [expr -$section-1]} {$i <= $section} {incr i} {
if {$i < [expr -$section]} {
lappend value_range_new "\<[expr [expr $i+1]*$value]";
} elseif {$i == $section} {
lappend value_range_new "\>[expr $i*$value]";
} else {
lappend value_range_new "\[[expr $i*$value]\,[expr [expr $i +1]*$value]\)";
}
}
then if I puts the list out, the result is following:
<-10 {[-10,-8)} {[-8,-6)} {[-6,-4)} {[-4,-2)} {[-2,0)} {[0,2)} {[2,4)} {[4,6)} {[6,8)} {[8,10)} >10
The confusing point is I do not understand where the {} comes from. If I define the list manually like following :
set a "\<-8 \[-8,-6\) \[-6,-4\) ";
the puts result has no {}. So what's wrong with my code, and how to remove/
In Tcl, you need to be aware which commands want to work with lists and which commands want to work with strings. lappend is a list command. puts takes a string. When you give puts a list, Tcl will convert the list into its string representation. That means that you'll see some extra braces and perhaps backslashes to protect list elements that have special characters (like [ and ]).
You can convert the list into a string easily with the join command.
For building strings, the format command can aid readability.
Additionally, you don't need to next expr commands, use parentheses; and brace your expressions:
set section 5;
set value 2;
set value_range_new "";
for { set i [expr {-$section-1}]} {$i <= $section} {incr i} {
set this [expr {$i * $value}]
set next [expr {($i + 1) * $value}]
if {$i < -$section} {
lappend value_range_new [format {<%d} $next]
} elseif {$i == $section} {
lappend value_range_new [format {>%d} $this]
} else {
lappend value_range_new [format {[%d,%d)} $this $next]
}
}
puts [join $value_range_new]
outputs
<-10 [-10,-8) [-8,-6) [-6,-4) [-4,-2) [-2,0) [0,2) [2,4) [4,6) [6,8) [8,10) >10
The shorter variant of algorithm. Not a single if is needed actually.
set section 5;
set value 2;
set this [expr {-$section * $value}]
set value_range_new [format {<%d} $this]
for {set i -$section} {$i < $section} {incr i} {
lappend value_range_new [format {[%d,%d)} $this [incr this $value]]
}
lappend value_range_new [format {>%d} $this]
puts [join $value_range_new]

Resources