How do I enforce fully bytecode compiling? - tcl

I am using TCL8.6.8.
Here is my experiment:
>cat ~/tmp/1.tcl
proc p {} {
foreach i {a b c} {
if {$i == "b"} {
break
}
puts $i
}
}
Now I come into tclsh:
% proc disa {file_name} {
set f [open $file_name r]
set data [read -nonewline $f]
close $f
tcl::unsupported::disassemble script $data
}
% disa ~/tmp/1.tcl
ByteCode 0x0x55cabfc393b0, refCt 1, epoch 17, interp 0x0x55cabfbdd990 (epoch 17)
Source "proc p {} {\nforeach i {a b c} {\n if {$i == \"b\"} ..."
Cmds 1, src 175, inst 11, litObjs 4, aux 0, stkDepth 4, code/src 1.26
Code 220 = header 168+inst 11+litObj 32+exc 0+aux 0+cmdMap 4
Commands 1:
1: pc 0-9, src 0-87
Command 1: "proc p {} {\nforeach i {a b c} {\n if {$i == \"b\"} ..."
(0) push1 0 # "proc"
(2) push1 1 # "p"
(4) push1 2 # ""
(6) push1 3 # "\nforeach i {a b c} {\n if {$i == \"b..."
(8) invokeStk1 4
(10) done
You can see that it is not fully compiled to bytecode in that the nesting script of foreach is taken as literal string.
Now I use tcl::unsupported::disassemble proc instead of tcl::unsupported::disassemble script, I can get a fully bytecode compiled version:
% source ~/tmp/1.tcl
% tcl::unsupported::disassemble proc p
ByteCode 0x0x55cabfc393b0, refCt 1, epoch 17, interp 0x0x55cabfbdd990 (epoch 17)
Source "\nforeach i {a b c} {\n if {$i == \"b\"} {\n ..."
File "/home/jibin/tmp/1.tcl" Line 1
Cmds 4, src 76, inst 54, litObjs 4, aux 1, stkDepth 5, code/src 4.21
Code 320 = header 168+inst 54+litObj 32+exc 28+aux 16+cmdMap 16
Proc 0x0x55cabfc72820, refCt 1, args 0, compiled locals 1
slot 0, scalar, "i"
Exception ranges 1, depth 1:
0: level 0, loop, pc 7-47, continue 49, break 50
Commands 4:
1: pc 0-52, src 1-74 2: pc 7-41, src 25-60
3: pc 23-36, src 50-54 4: pc 42-47, src 66-72
Command 1: "foreach i {a b c} {\n if {$i == \"b\"} {\n br..."
(0) push1 0 # "a b c"
(2) foreach_start 0
[jumpOffset=-42, vars=[%v0]]
Command 2: "if {$i == \"b\"} {\n break\n ..."
(7) startCommand +34 1 # next cmd at pc 41, 1 cmds start here
(16) loadScalar1 %v0 # var "i"
(18) push1 1 # "b"
(20) eq
(21) jumpFalse1 +18 # pc 39
Command 3: "break..."
(23) startCommand +14 1 # next cmd at pc 37, 1 cmds start here
(32) jump4 +18 # pc 50
(37) jump1 +4 # pc 41
(39) push1 2 # ""
(41) pop
Command 4: "puts $i..."
(42) push1 3 # "puts"
(44) loadScalar1 %v0 # var "i"
(46) invokeStk1 2
(48) pop
(49) foreach_step
(50) foreach_end
(51) push1 2 # ""
(53) done
Here is my question: Why doesn't tcl::unsupported::disassemble script fully compile the script? foreach command is inside a proc, I'd imagine that the compiling function of proc invokes the compiling function of each command, so the compiling function of foreach command is invoked regardless.

Tcl postpones the compilation of a script or procedure until the first time the bytecoded version of the script/procedure is needed. Compilation is fairly fast (and cached carefully, where that makes sense) and the optimizer in 8.6 is lightweight (just killing some of the stupider code sequences that used to be generated), so this isn't typically a big problem. The degree of compilation done for a particular command varies a lot: expr is almost always deeply compiled (if possible!) and proc itself is never compiled; what you're seeing in the disassembly is generic command call compilation (push the words on the stack, call a generic command with that many words, job done). This makes sense because most calls of proc happen once only and only really set things up for interesting things to happen later. The chances of us changing proc itself to gain deep compilation (as opposed to the procedures it creates) are zero, at least for 8.7/9.0 and probably well ahead there. There's just no win possible to justify the work it would take.
However, if you want to trigger procedure compilation early, you can. All it takes is a little triggering…
trace add execution proc leave {apply {{cmdArgs code result op} {
if {$code == 0} {
# proc succeeded; it must have been called as: proc name args body
set procedureName [lindex $cmdArgs 1]
# Make sure we resolve the procedure name in the right namespace!
set compTime [lindex [time {
uplevel 1 [list tcl::unsupported::getbytecode proc $procedureName]
}] 0]
# We're done now! Totally optional print of how long it took…
puts stderr "Compiled $procedure in $compTime µs"
}
}}}
I think that getbytecode is a little faster than disassemble (it's doing the same general thing but produces machine-readable output) but I might be wrong. You'll need to use disassemble if the code is to be used in 8.5.

Related

Does TCL containg built in functions of type get_bits and set_bits?

The get_bits will return specific bits of a value and set_bits will set specific bits of a value to a specified value. Does TCL contain such functions built in or should they be written by the user?
The binary scan command does come close to the get_bits function but is not the same thing.
There's no specific function for getting or setting a particular bit. We can make them.
proc get_bit {value bit} {
expr {($value & (1 << $bit)) != 0}
}
proc set_bit {varName bit {value 1}} {
upvar 1 $varName var
if {$value} {
set var [expr {$var | (1 << $bit)}]
} else {
set var [expr {$var & ~(1 << $bit)}]
}
}
Those will work with integer values of any width; you're not restricted to 32 bits or 64 bits.
# Lots of bits!
set x 123456789012345678901234567890
# Fetch a particular bit
puts [get_bit $x 17]
# Set a bit to 1
set_bit x 78
puts "x = $x"
# Set a bit to 0
set_bit x 75 0
puts "x = $x"

finding difference between list elements in Tcl

I am a beginner in using Tcl. I am using it as VMD (molecular visualization) software uses it as a scripting language.
I have a list of co-ordinates of atom positions for a protein like: {{1 2 3} {7 9 13}, ...} I have a separate list of the same length with different positions say: {{3 5 2} {7 3 8}, ...}.
VMD has an inbuilt vecsub function which can subtract {1 2 3} and {3 5 2} to give {-2 -3 1}. I have written a foreach loop to iterate on the entire list and calculate vecsub.
My code is as follows:\
set sel1 [atomselect 0 "protein"] # selecting protein1
set sel2 [atomselect 1 "protein"] # selecting protein2
# create a list of same length as protein to store values
# $sel1 get index returns length of protein
foreach i [$sel1 get index] {
lappend x 0
}
# veclength2 returns square of vector length
# $sel1 get {x y z} returns a position list as described earlier
foreach i [$sel1 get index] {
lset x $i [expr [veclength2 [vecsub [lindex [$sel1 get {x y z}] $i] [lindex [$sel2 get {x y z}] $i]]]]
}
Is there another way to do this in Tcl? Similar to python array subtraction perhaps?
I would try this, but it's just a guess
set x [lmap p1 [$sel1 get {x y z}] p2 [$sel2 get {x y z}] {
expr [veclength2 [vecsub $p1 $p2]]
}]
With this, there's no need to pre-declare $x

Fast string replace

After building up a potentially very large string, I'm going to do a lot of changing single characters in it (or bytes, if necessary), to another char.
Actually, my script is building a crossword puzzle, so the string won't be very long, but my question is general:
How can I use the fact that I'm not altering the strings (or whatever data type is better) length, to speed things up?
I guess part of what I'm looking for is a way to send a pointer or reference to the string, or in Tcl's case the variable name.
My other question is what happens internally in the C code.
Will this call copy the entire string zero, one or even two times?
set index [expr {$row * $width + $col}]
set puzzle [string replace $puzzle $index $index "E"]
The string replace operation will do an in-place change provided two conditions are satisfied:
The string being inserted must be the same length as the string being excised. I assume this one is obvious to you.
The string must be in an unshared reference, so that nothing else can observe the value being modified. (This is a critical part of how all Tcl references work; shared references cannot be modified in-place.)
That call, as written, will copy. This is predictable based on simple examination of the reference handling for the string; the issue is that the old version of the string remains in puzzle until after the string replace completes (the set needs the result to work). To fix that, we do this slightly strange thing:
set puzzle [string replace $puzzle[set puzzle {}] $index $index "E"]
Yes, this is weird but it works well because concatenation with a known-empty string is an explicitly optimised case, assuming you're dealing with untraced variables here. (It'll work with traced variables, but the double write is observable and traces could do tricky things so you lose optimisation opportunities.)
If you were doing extensive changes that sometimes change the length of things, switching to using lists and lset would be more efficient. The equivalent operations on lists all use the same general reference and in-place semantics, but work on list elements instead of characters.
Disassembly
The optimisation I'm talking about is in the strcat opcode, and strreplace knows to do in-place when it can but you don't see the information at the bytecode level; virtually all operations know that.
% tcl::unsupported::disassemble lambda {{puzzle index} {
set puzzle [string replace $puzzle[set puzzle {}] $index $index "E"]
}}
ByteCode 0x0x7fbff6021c10, refCt 1, epoch 17, interp 0x0x7fbff481e010 (epoch 17)
Source "\n set puzzle [string replace $puzzle[set puzzle {}]..."
Cmds 3, src 74, inst 18, litObjs 2, aux 0, stkDepth 4, code/src 0.00
Proc 0x0x7fbff601cc90, refCt 1, args 2, compiled locals 2
slot 0, scalar, arg, "puzzle"
slot 1, scalar, arg, "index"
Commands 3:
1: pc 0-16, src 5-72 2: pc 0-14, src 17-71
3: pc 2-5, src 40-52
Command 1: "set puzzle [string replace $puzzle[set puzzle {}] $inde..."
Command 2: "string replace $puzzle[set puzzle {}] $index $index \"E..."
(0) loadScalar1 %v0 # var "puzzle"
Command 3: "set puzzle {}..."
(2) push1 0 # ""
(4) storeScalar1 %v0 # var "puzzle"
(6) strcat 2
(8) loadScalar1 %v1 # var "index"
(10) loadScalar1 %v1 # var "index"
(12) push1 1 # "E"
(14) strreplace
(15) storeScalar1 %v0 # var "puzzle"
(17) done

Test if matrix object exists in TCL

I want to test if a tcl-matrix object exists. How can I do that?
Following code isn't working.
package require struct::matrix
# Test (now we expect 0)
info exists m
# Create the object
struct::matrix m
# Test again, now I expect 1, however it returns 0!!!
info exists m
Use info commands to test for the existence of a matrix object. info exists tests for the (non-)existence of variables.
% package req struct::matrix
2.0.3
% info commands m
% struct::matrix m
::m
% info commands m
m
Background
A matrix object is implemented as a Tcl command (an alias command, to be precise) plus per-matrix Tcl namespace (as storage).
Alternatively, but this depends to much on the current implementation, you may test for the existence of a so-named namespace:
% package req struct::matrix
2.0.3
% namespace exists m
0
% struct::matrix m
::m
% namespace exists m
1
Testing for the command will also keep working when a matrix object becomes re-implemented as a TclOO object, for instance.
With a bit of poking through the struct::matrix source code:
% package req struct::matrix
2.0.3
% set m [struct::matrix]
::matrix1
% expr {$m in [interp aliases]}
1
% string first MatrixProc [interp alias {} $m]
18
% proc is_matrix {name} {
expr {
$name in [interp aliases] &&
[string first MatrixProc [interp alias {} $name]] != -1
}
}
% is_matrix $m
1
If you use the struct::matrix m form, then instead of $m, use the fully qualified ::m
% struct::matrix m
::m
% is_matrix m
0
% is_matrix ::m
1

A follow-on to Donal about expr command performance

I just read the great reply from Donal Fellows on this question. It is so informative.
But I have a question about this part: never use a dynamic expression with if, for or while as that will suppress a lot of compilation.
I read it twice, but do not think I totally get it.
Donal or others, could you elaborate it a little bit more?
[UPDATE1]
Out of curiosity, I tried inside tkcon the example Donal gave in his reply:
% set a {1||0}
1||0
% set b {[exit 1]}
[exit 1]
% expr {$a + $b}
can't use non-numeric string as operand of "+"
% expr $a + $b
1
Interesting, why "expr $a + $b" ends up "1"? Isn't "expr $a + $b" expanded into "expr 1||0 + [exit 1]"? If I just run the expanded version, tkcon just closes which makes senses to me because [exit 1] runs.
[UPDATE2] I am still pondering about my question in UPDATE1. As suggested, I did one more experiment:
% concat $a + $b
1||0 + [exit 1]
% expr 1||0 + [exit 1]
...tkcon closes...
tkcon closing is what I expected, still wondering why expr $a + $b yields 1.
You're strongly discouraged from composing expressions that way, as it is easy to get it wrong and create a (potential) security hole.
set x 1
set y {[exec echo >#stdout rm -rf /]}; # Assume this string has come from the user
expr $x+$y
# After Tcl language substitution, it's equivalent to this:
# expr {1+[exec echo >#stdout rm -rf /]}
# If you're not sure why that might be a problem, think a little more...
It also is not strongly compiled, since Tcl's bytecode compiler does not (in general) do a lot of constant folding, and instead you get an invoke of the opcode that takes a string and compiles that string at runtime into bytecode for execution. It's not efficient as well as unsafe.
However, there's more. If we look at this instead:
if $x==$y {
# ...
}
The body of that if is not compiled because the if compiler code is just sees the substitutions and bails out, pushing things back to (effectively) interpreted mode execution. That will slow down the whole arm of the if. If you are doing composed expressions (which I discourage for safety reasons) then at least do this:
if {[expr $x==$y]} {
# ...
}
That at least keeps the if in its efficient mode. (It's otherwise semantically equivalent.)
Bytecode for the above
First, for expr.
% tcl::unsupported::disassemble script {expr $x+$y}
ByteCode 0x0x1008b2210, refCt 1, epoch 96, interp 0x0x100829a10 (epoch 96)
Source "expr $x+$y"
Cmds 1, src 10, inst 12, litObjs 3, aux 0, stkDepth 3, code/src 0.00
Commands 1:
1: pc 0-10, src 0-9
Command 1: "expr $x+$y"
(0) push1 0 # "x"
(2) loadStk
(3) push1 1 # "+"
(5) push1 2 # "y"
(7) loadStk
(8) strcat 3
(10) exprStk
(11) done
% tcl::unsupported::disassemble script {expr {$x+$y}}
ByteCode 0x0x1008eb610, refCt 1, epoch 96, interp 0x0x100829a10 (epoch 96)
Source "expr {$x+$y}"
Cmds 1, src 12, inst 8, litObjs 2, aux 0, stkDepth 2, code/src 0.00
Commands 1:
1: pc 0-6, src 0-11
Command 1: "expr {$x+$y}"
(0) push1 0 # "x"
(2) loadStk
(3) push1 1 # "y"
(5) loadStk
(6) add
(7) done
Note that in the first version we use exprStk (a general string operation) whereas the second version uses add (which knows it is working with numbers and throws errors otherwise).
Then, for if.
% tcl::unsupported::disassemble script {if $x==$y {
incr hiya
}}
ByteCode 0x0x10095e210, refCt 1, epoch 96, interp 0x0x100829a10 (epoch 96)
Source "if $x==$y {\n incr hiya\n "...
Cmds 1, src 35, inst 17, litObjs 5, aux 0, stkDepth 4, code/src 0.00
Commands 1:
1: pc 0-15, src 0-34
Command 1: "if $x==$y {\n incr hiya\n "...
(0) push1 0 # "if"
(2) push1 1 # "x"
(4) loadStk
(5) push1 2 # "=="
(7) push1 3 # "y"
(9) loadStk
(10) strcat 3
(12) push1 4 # "\n incr hiya\n "...
(14) invokeStk1 3
(16) done
% tcl::unsupported::disassemble script {if {[expr $x==$y]} {
incr hiya
}}
ByteCode 0x0x10095cc10, refCt 1, epoch 96, interp 0x0x100829a10 (epoch 96)
Source "if {[expr $x==$y]} {\n incr hiya\n "...
Cmds 3, src 44, inst 32, litObjs 5, aux 0, stkDepth 3, code/src 0.00
Commands 3:
1: pc 0-30, src 0-43 2: pc 0-10, src 5-15
3: pc 14-26, src 29-37
Command 1: "if {[expr $x==$y]} {\n incr hiya\n "...
Command 2: "expr $x==$y"...
(0) push1 0 # "x"
(2) loadStk
(3) push1 1 # "=="
(5) push1 2 # "y"
(7) loadStk
(8) strcat 3
(10) exprStk
(11) nop
(12) jumpFalse1 +17 # pc 29
Command 3: "incr hiya"...
(14) startCommand +13 1 # next cmd at pc 27, 1 cmds start here
(23) push1 3 # "hiya"
(25) incrStkImm +1
(27) jump1 +4 # pc 31
(29) push1 4 # ""
(31) done
Notice how the second version has understood that it is doing an increment (incrStkImm)? That helps a lot with performance, especially for longer, less-trivial scripts. The first version just assembles a list of arguments and uses invokeStk1 to call the interpreted if implementation.
FWIW, the “gold standard” (assuming we're not in a procedure) is this:
% tcl::unsupported::disassemble script {if {$x==$y} {
incr hiya
}}
ByteCode 0x0x1008efb10, refCt 1, epoch 96, interp 0x0x100829a10 (epoch 96)
Source "if {$x==$y} {\n incr hiya\n"...
Cmds 2, src 29, inst 18, litObjs 4, aux 0, stkDepth 2, code/src 0.00
Commands 2:
1: pc 0-16, src 0-28 2: pc 9-12, src 18-26
Command 1: "if {$x==$y} {\n incr hiya\n"...
(0) push1 0 # "x"
(2) loadStk
(3) push1 1 # "y"
(5) loadStk
(6) eq
(7) jumpFalse1 +8 # pc 15
Command 2: "incr hiya"...
(9) push1 2 # "hiya"
(11) incrStkImm +1
(13) jump1 +4 # pc 17
(15) push1 3 # ""
(17) done
And for completeness, inside a procedure (well, lambda in this case, but the bytecode is identical):
tcl::unsupported::disassemble lambda {{} {if {$x==$y} {
incr hiya
}}}
ByteCode 0x0x1008ecc10, refCt 1, epoch 96, interp 0x0x100829a10 (epoch 96)
Source "if {$x==$y} {\n incr hiya\n"...
Cmds 2, src 29, inst 15, litObjs 1, aux 0, stkDepth 2, code/src 0.00
Proc 0x0x102024610, refCt 1, args 0, compiled locals 3
slot 0, scalar, "x"
slot 1, scalar, "y"
slot 2, scalar, "hiya"
Commands 2:
1: pc 0-13, src 0-28 2: pc 7-9, src 18-26
Command 1: "if {$x==$y} {\n incr hiya\n"...
(0) loadScalar1 %v0 # var "x"
(2) loadScalar1 %v1 # var "y"
(4) eq
(5) jumpFalse1 +7 # pc 12
Command 2: "incr hiya"...
(7) incrScalar1Imm %v2 +1 # var "hiya"
(10) jump1 +4 # pc 14
(12) push1 0 # ""
(14) done