TCL proc and byte code compile - what is the link? - tcl

Several times I run into mentioning that it is best to put script into proc in order to boost run time performance, e.g. this answer has the following:
That is one reason for the advices to put all your code inside procedures (they get byte-compiled that way)
Something does not click in me.
Just as described in the answer, the first time a script runs, there is a check if a command can be byte-code compiled, if it is, then it is compiled. This makes total sense. But I do not see how "proc" plays an important role. E.g. compare the following 2 scripts:
set v [concat [lindex $::argv 1] [lindex $::argv 2]]
myCmd $v
and
proc p1 {v1 v2} {
set v [concat $v1 $v2]
return [myCmd $v]
}
p1 [lindex $::argv 1] [lindex $::argv 2]
My high level interpretation of the 2 scripts tells the following:
In running either script the first time, "set", "concat", "lindex" and "return" commands are compiled
The second script also has "proc" compiled.
"myCmd" is not compiled in either script
Subsequent running of either script runs the bycode except "myCmd".
So what is the advantage of "proc"?
I did run dissamble on the scripts:
The first script:
ByteCode 0x0x83fc70, refCt 1, epoch 3, interp 0x0x81d680 (epoch 3)
Source "set v [concat [lindex $::argv 1] [lindex $::argv 2]]\nmy"
Cmds 5, src 61, inst 50, litObjs 4, aux 0, stkDepth 4, code/src 0.00
Commands 5:
1: pc 0-41, src 0-51 2: pc 2-39, src 7-50
3: pc 4-20, src 15-30 4: pc 21-37, src 34-49
5: pc 42-48, src 53-60
Command 1: "set v [concat [lindex $::argv 1] [lindex $::argv 2]]"
(0) push1 0 # "v"
Command 2: "concat [lindex $::argv 1] [lindex $::argv 2]"
(2) push1 1 # "concat"
Command 3: "lindex $::argv 1"
(4) startCommand +17 1 # next cmd at pc 21
(13) push1 2 # "::argv"
(15) loadScalarStk
(16) listIndexImm 1
Command 4: "lindex $::argv 2"
(21) startCommand +17 1 # next cmd at pc 38
(30) push1 2 # "::argv"
(32) loadScalarStk
(33) listIndexImm 2
(38) invokeStk1 3
(40) storeScalarStk
(41) pop
Command 5: "myCmd $v"
(42) push1 3 # "myCmd"
(44) push1 0 # "v"
(46) loadScalarStk
(47) invokeStk1 2
(49) done
The second script:
ByteCode 0x0xc06c80, refCt 1, epoch 3, interp 0x0xbe4680 (epoch 3)
Source "proc p1 {v1 v2} {\n set v [concat $v1 $v2]\n return"
Cmds 4, src 109, inst 50, litObjs 5, aux 0, stkDepth 4, code/src 0.00
Commands 4:
1: pc 0-10, src 0-67 2: pc 11-48, src 69-108
3: pc 13-29, src 73-88 4: pc 30-46, src 92-107
Command 1: "proc p1 {v1 v2} {\n set v [concat $v1 $v2]\n return"
(0) push1 0 # "proc"
(2) push1 1 # "p1"
(4) push1 2 # "v1 v2"
(6) push1 3 # "\n set v [concat $v1 $v2]\n return ["
(8) invokeStk1 4
(10) pop
Command 2: "p1 [lindex $::argv 1] [lindex $::argv 2]"
(11) push1 1 # "p1"
Command 3: "lindex $::argv 1"
(13) startCommand +17 1 # next cmd at pc 30
(22) push1 4 # "::argv"
(24) loadScalarStk
(25) listIndexImm 1
Command 4: "lindex $::argv 2"
(30) startCommand +17 1 # next cmd at pc 47
(39) push1 4 # "::argv"
(41) loadScalarStk
(42) listIndexImm 2
(47) invokeStk1 3
(49) done
So script 2 does have 1 less TCL command, but both scripts have 49 byte code commands.
Finally the running test, I comment out "myCmd" because I actually do not have such extension. Here is the result:
% time {source 1.tcl} 10000
242.8156 microseconds per iteration
% time {source 2.tcl} 10000
257.9389 microseconds per iteration
So the proc version is even slower.
What do I miss? Or rather, what is the exact understanding of proc and performance?

The really big reason that putting things in a procedure matters is that procedures have a local variable table. Variables in the LVT can be accessed by numerical index, which is stupendously faster than the alternative (a lookup via a hash table, even though Tcl's got an extremely fast hash table implementation). It doesn't make much difference for a one-off call, but with repeated calls or a loop, the performance differences rapidly add up to something significant. This can quite easily make the extra cost of the extra compilation and stack frame management (procedures aren't free to enter, though we try to keep them cheap) basically irrelevant in real scripts.
And yes, Tcl actually bytecode-compiles everything. It's just that it often generates sub-optimal bytecode outside of procedure(-like context)s; in the limit case for suboptimality, all the bytecode is doing is assembling arguments into a list, doing a dynamic command invoke, and routing the result.
(It's important when reading Tcl's disassembled bytecode to remember that the costs of particular bytecodes are not all the same. You cannot just count the number of instructions to work out the cost in any useful way. For example, push1 is very cheap but invokeStk1 is potentially very costly. Another example, loadScalarStk is usually much more expensive than loadScalar1; the latter is used inside procedures only.)

The following two scripts demonstrate the performance gain due to usage of procs. In the second script the internal loop is extracted into a proc, leading to a 5x speedup.
without_proc.tcl
#!/usr/bin/env tclsh
set sum 0
set n 10000
set k 100
for { set i 0 } { $i < $k } { incr i } {
set s 0
for { set j 0 } { $j < $n } { incr j } {
set s [expr {$s + $j}]
}
set sum [expr {$sum + $s}]
}
puts "sum=$sum"
with_proc.tcl
#!/usr/bin/env tclsh
proc foo {n} {
set s 0
for { set j 0 } { $j < $n } { incr j } {
set s [expr {$s + $j}]
}
return $s
}
set sum 0
set n 10000
set k 100
for { set i 0 } { $i < $k } { incr i } {
set s [foo $n]
set sum [expr {$sum + $s}]
}
puts "sum=$sum"
Benchmark:
$ tclsh
% time {source with_proc.tcl} 1
sum=4999500000
67482 microseconds per iteration
% time {source without_proc.tcl} 1
sum=4999500000
406557 microseconds per iteration
or
$ time tclsh with_proc.tcl
sum=4999500000
real 0m0.089s
user 0m0.080s
sys 0m0.004s
$ time tclsh without_proc.tcl
sum=4999500000
real 0m0.401s
user 0m0.388s
sys 0m0.016s

Related

Can be used an expression in the name of variable for reading it in Tcl?

#In Tclsh
% set n 3
3
% set A$n 15
15
% puts $A3
15
But how could I read $A3 as about like ${A{$n}}
Itried:
% puts $[puts \$A$n]
$A3
$
%
I clarify my question date:10Aug2022 (UTC 09.14)
In Bash I can do a deeper indirection as like this:
a=b;b=5;eval echo $`echo $a` # output: 5 is good
How can I do it in Tcl with puts command instead of set command as like this:
set a b;set b 5;eval {puts [puts \$$a]} # it has wrong output: $b rather than 5
Macleod showed that the set command with only one argument is a workaround of a deeper indirection.
That is why the next line is good:
set a b;set b 5;eval puts $[set a] # Output: 5 as required is good
So my question is:
In the above Tcl line how can I replace the set command with puts command and do a deeper indirection in Tcl as like in Bash.
/echo in Bash is as like puts in Tcl/
My question is not for a practical purpose, but for understanding the parsing, substitution in Tcl.
Should work with just:
puts [set A$n]
I have read the Tcl man about substitution process and I have made some experiments.
The puts command unusable for command substitution according to the next examples.
% set x 1; set x [puts 2]; puts "x: >$x<"
x: ><
% set x 1; set x [puts -nonewline 2]; puts "\nx: >$x<"
x: ><
% set x 1; set x [expr 2]; puts "x: >$x<"; # But expr cmd ok of course.
x: >2<
( In Bash the echo command is good for command substitution eg.: a=`echo "apple tree"` )
I checked more type of deeper indirect addressing of variable, here is my experiments:
Now let the names of var is numbers.
% set 1 2; set 2 3; set 3 4; #Here is the chain of var
% puts [set [set [set 1]]]; #Command substitution only
4
% puts [expr $[expr $[expr $[expr 1]]]]; #Command and variable substitution
4
Now let the names of var is alphas and change the expr command to the string trim as a dummy string
expression command.
% set a b; set b c; set c d ; # Here is the chain of var
% puts [set [set [set a]]] ; # Command substitution only
d
# Command and variable substitution:
% puts [eval string trim $[eval string trim $[eval string trim $[string trim a]]]]
d
I would like to know why I had to use eval command unlike in case when the names of var were numbers
and expr command was enough.
In spite of there were deep (indirect) var (and command) substitution was in both two cases .
So it is looks like that deep command substitution controlled by brackets while deep (indirect) var substitution
controlled by eval often.
Likewise in Bash the deep var substituting also happens with eval command, e.g.:
a=b; b=c; c=d # Here is the chain of var
eval echo \$$(eval echo \$$(eval echo \$a))
d

Finding Signed Decimal equivalent of a 2's complement binary

I have a TCL procedure that intends to find the signed decimal equivalent of a Binary(which in fact was originally from a HEX).
Ex - Original HEX -- cc
Equivalent BIN -- 1100 1100
Now, to find the signed decimal equivalent, I need to do the following:
a. Find 1's complement of the "Equivalent BIN"
b. Add 1 to [Step a]'s result -- then, convert that BIN to HEX, convert to DEC after that.
c. Convert [Step b]'s output(BIN) to HEX.
d. Convert [Step c]'s output(HEX) to DEC.
I'm unable to proceed from Step b -- My code:
proc revTwosComplmnt { bin } {
for {set i 0} {$i < [string length $bin]} {incr i} {
if {[string index $bin $i]} {
append ret 0
} else {
append ret 1
}
}
puts "ret after 1's complement is -------------------> $ret"
set ret [expr $ret + 1]
puts "ret after adding 1 is -------------------> $ret"
set ret [binary scan B* $ret]
puts "ret is -------------------> $ret" }
Output:
rssibin[0] is 11001100
ret after 1's complement is -------------------> 00110011
ret after adding 1 is -------------------> 36874
bad field specifier "3"
while executing
"binary scan B* $ret"
(procedure "TwosComplmnt" line 12)
invoked from within
"TwosComplmnt [lindex $rssibin $i]"
(procedure "CSIRSSI" line 22)
invoked from within
"CSIRSSI $line0 4"
(file "CSIRecord.test" line 238)
Please help me in how to proceed.
Your add-one step is not doing what you expect. It happens to not error on the value you tried, but the value it is computing is definitely not what you were expecting! The issue is that the expr command is interpreting 00110011 as an octal number, not as binary.
The simplest method for converting binary digits into a number you can do arithmetic on is to use scan with a %b format:
scan $ret "%b" ret
It might be better to the bit-negation in expr as well:
proc revTwosComplmnt { bin } {
# Convert to numeric
scan $bin "%b" value
# Do the operation; look up what the ~ operator does...
set value [expr { ~$value + 1 }]
# Filter this result to the low 8 bits; Tcl math is infinite-precision
set ret [expr {$value & 0xFF}]
# Convert to binary bit string
return [format "%08b" $ret]
}
# Testing
puts [revTwosComplmnt 11001100]; # ==> 00110100
binary scan takes the input data before the format not after, see https://www.tcl-lang.org/man/tcl8.6/TclCmd/binary.htm#M3 . So you should write
set ret [binary scan $ret B*]
By the way, a shorter way to write your loop would be
foreach bit [split $bin {}] {
append ret [expr {$bit ? 0 : 1}]
}
This is the final solution I worked up to:
proc revTwosComplmnt { bin } {
set tret ""
set binarr [split $bin {}]
for {set index [expr [llength $binarr] - 1]} {$index >= 0} {incr index -1} {
if {[regexp {^0*$} $tret -]} {
#Append will not work here, hence need to prepend the bits
set tret "[lindex $binarr $index]$tret"
continue
}
set tret "[expr {[lindex $binarr $index] ? 0: 1}]$tret"
}
#puts "\n\nTwo's Complement value for $bin is $tret\n\n"
return $tret
}
Here, I was trying to return a Binary string as the 2's complement. I would later use these 8 binary characters and divide them in 2 groups of 4 binchars. Convert them to Hexadecimal and thereafter to Decimal if need be.

Calculate average of columns of column with Tcl

I want to calculate the average for this column with tcl
please help me
frame Elec
1 50
2 40
3 30
4 20
If this is for a standalone script, (Warning: Self promotion ahead), I wrote a program called tawk that's like awk except using TCL for scripting, which does most of the work for you:
$ tawk 'line {$NR > 1} { incr sum $F(2) }
END { puts [expr {double($sum) / ($NR - 1)}] }' input.txt
35
# Equivalent awk:
$ awk 'NR > 1 { sum += $2 } END { print (sum / (NR - 1)) }' input.txt
35
If it's part of a larger program, you have to open the file and read and split lines yourself. Maybe something like
# Column number is 1-based
proc avg_column {filename column} {
set f [open $filename r]
gets $f ;# Read and discard header line
set sum 0
set nlines 0
while {[gets $f line] >= 0} {
set columns [regexp -all -inline {\S+} $line]
incr sum [lindex $columns $column-1]
incr nlines
}
close $f
return [expr {double($sum) / $nlines}]
}
puts [avg_column input.txt 2]
Not an answer, but some tips. You need to:
open the file
read the header with gets
use a while loop to read lines of the file
use split or regexp to get the 2nd field
sum the values (and count the lines) with expr, or incr if the values are only integers
If your input happens to be (some sort of CSV), or you can steer it into this direction, then you may use tcllib's csv package:
package require csv
package require struct::matrix
struct::matrix dm
set f [open mydata.csv]
while {[gets $f l] >= 0} {
# sanitize input, line-wise
set l [regsub -all {\s+} $l " "]
csv::split2matrix dm $l " " auto
}
close $f
set columnData [lrange [dm get column 1] 1 end]; # strip off header
puts [expr {double([tcl::mathop::+ {*}$columnData])/[llength $columnData]}]; # compute avg
Some hints:
gets will read your input file line by line;
csv::split2matrix puts each line into a struct::matrix;
/matrix/ get column /n/ gives access to one data column (incl. header field);
tcl::mathop::+ gives access to the built-in addition operator (outside of the [expr] command) and supports 2+ summands.

cmdline argument parsing using tcl?

I am trying to pass the parameters to Spirent test center tool using command line arguments, where I am passing slots, ports, frame size and load. I want to store the Slots and ports in array, where number of ports are dynamic.
I tried simple code with cmdline which can handle fixed ports
package require cmdline
set parameters {
{s.arg "" "Slot"}
{p.arg "" "Port"}
{l.arg "100" "Load"}
{f.arg "256" "Framesize"}
{debug "Turn on debugging, default=off"}
}
#set option(l) 100
set usage "- A simple script to demo cmdline parsing"
if {[catch {array set options [cmdline::getoptions ::argv $parameters $usage]}]} {
puts [cmdline::usage $parameters $usage]
} else {
parray options
}
#puts [array get options]
puts $options(l)
puts $options(f)
script Output:
C:\Tcl\bin>tclsh opt.tcl -s 1 -f 128
options(debug) = 0
options(f) = 128
options(l) = 100
options(p) =
options(s) = 1
100
128
Here I would like to pass all the ports for each slots onetime ,
tclsh opt.tcl -s 1 2 -p 11 12 13 14 -f 256 -l 100
Where slots are 1 and 2 and ports in each slot are 11,12,13,14 and need to create array of slot and ports. Could you please suggest some method to achieve this.
Try
tclsh opt.tcl -s "1 2" -p "11 12 13 14" -f 256 -l 100
It works for me under Windows 10, at least. The thing is that the lists of slots and ports need to be one value each: the quotes ensure that.
I tried the following method with some corrections:
set arglen [llength $argv]
while {$index < $arglen} {
set arg [lindex $argv $index]
#puts $arg
switch -exact -- $arg {
-s {
set args($arg) [lindex $argv [incr index]]
set slot($y) $args($arg)
incr y
}
-p {
set args($arg) [lindex $argv [incr index]]
set port($z) $args($arg)
incr z
}
-l {
set args($arg) [lindex $argv [incr index]]
global Load
set Load $args($arg)
}
-f {
set args($arg) [lindex $argv [incr index]]
set frameLength $args($arg)
}
}
incr index
}
Command to run:
C:\Tcl\bin>tclsh l1.tcl -s 1 -p 11 -p 12 -l 10 -f 1

Expanded TCL interpreter in TCL

I have implemented many TCL extensions for a specific tool in the domain of formal methods (extensions are implemented in C but I do not want solution to rely on this fact). Thus, the users of my tool can use TCL for prototyping algorithms. Many of them are just linear list of commands (they are powerfull), e.g.:
my_read_file f
my_do_something a b c
my_do_something_else a b c
Now, I am interested in timing. It is possible to change the script to get:
puts [time [my_read_file f] 1]
puts [time [my_do_something a b c] 1]
puts [time [my_do_something_else a b c] 1]
Instead of this I want to define procedure xsource that executes a TCL script and get/write timing for all my commands. Some kind of a profiler. I wrote a naive implementation where the main idea is as follows:
set f [open [lindex $argv 0] r]
set inputLine ""
while {[gets $f line] >= 0} {
set d [expr [string length $line] - 1]
if { $d >= 0 } {
if { [string index $line 0] != "#" } {
if {[string index $line $d] == "\\"} {
set inputLine "$inputLine [string trimright [string range $line 0 [expr $d - 1]]]"
} else {
set inputLine "$inputLine $line"
set inputLine [string trimleft $inputLine]
puts $inputLine
puts [time {eval $inputLine} 1]
}
set inputLine ""
}
}
}
It works for linear list of commands and even allows comments and commands over multiple lines. But it fails if the user uses if statements, loops, and definition of procedures. Can you propose a better approach? It must be pure TCL script with as few extensions as possible.
One way of doing what you're asking for is to use execution traces. Here's a script that can do just that:
package require Tcl 8.5
# The machinery for tracking command execution times; prints the time taken
# upon termination of the command. More info is available too (e.g., did the
# command have an exception) but isn't printed here.
variable timerStack {}
proc timerEnter {cmd op} {
variable timerStack
lappend timerStack [clock microseconds]
}
proc timerLeave {cmd code result op} {
variable timerStack
set now [clock microseconds]
set then [lindex $timerStack end]
set timerStack [lrange $timerStack 0 end-1]
# Remove this length check to print everything out; could be a lot!
# Alternatively, modify the comparison to print more stack frames.
if {[llength $timerStack] < 1} {
puts "[expr {$now-$then}]: $cmd"
}
}
# Add the magic!
trace add execution source enterstep timerEnter
trace add execution source leavestep timerLeave
# And invoke the magic, magically
source [set argv [lassign $argv argv0];set argv0]
# Alternatively, if you don't want argument rewriting, just do:
# source yourScript.tcl
Then you'd call it like this (assuming you've put it in a file called timer.tcl):
tclsh8.5 timer.tcl yourScript.tcl
Be aware that this script has a considerable amount of overhead, as it inhibits many optimization strategies that are normally used. That won't matter too much for uses where you're doing the real meat in your own C code, but when it's lots of loops in Tcl then you'll notice a lot.
You can wrap your commands which you want to measure. And name wrappers exactly as the original ones (renaming original procs before). After that, when instrumented command is executed it actually executes the wrapper, which executes the original procedure and measure the time of execution. The example below (Tcl 8.5).
proc instrument {procs} {
set skip_procs {proc rename instrument puts time subst uplevel return}
foreach p $procs {
if {$p ni $skip_procs} {
uplevel [subst -nocommands {
rename $p __$p
proc $p {args} {
puts "$p: [time {set r [__$p {*}\$args]}]"
return \$r
}
}]
}
}
}
proc my_proc {a} {
set r 1
for {set i 1} {$i <= $a} {incr i} {
set r [expr {$r * $i}]
}
return $r
}
proc my_another_proc {a b} {
set r 0
for {set i $a} {$i <= $b} {incr i} {
incr r $i
}
return $r
}
instrument [info commands my_*]
puts "100 = [my_proc 100]"
puts "200 = [my_proc 100]"
puts "100 - 200 = [my_another_proc 100 200]"
You might want to look at the command "info complete". It can tell you if what you have accumulated so far looks complete from the point of view of most common Tcl syntax markers. It will deal with command input that might be spread across multiple physical lines.