package require Thread
package require Itcl
proc dumplist {n cmd} {
set rc [list]
for {set i 0} {$i < $n} {incr i} {
lappend rc [eval $cmd]
}
return $rc
}
proc randstr {} {
set rc "x"
while {int(rand() * 5) != 0} {
append rc [lindex {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9} [expr {int(rand() * 36.0)}]]
}
return $rc
}
set tm [time {
set n 5
set list [dumplist $n {dumplist $n {dumplist $n {dumplist $n randstr}}}]
}]
puts "Creation: $tm"
itcl::class x {
private variable _var ""
public method vset {x} {
set _var $x
}
public method vget {} {
return ${_var}
}
}
x -ts x0
x0 vset $list
set tc {
format %d,%d,%d,%d \
[llength [x0 vget]] \
[llength [lindex [x0 vget] 0]] \
[llength [lindex [x0 vget] 0 0]] \
[llength [lindex [x0 vget] 0 0 0]]
}
set tm [time {set res [eval $tc]}]
puts R=$res,$tm
for {set i 0} {$i < 50} {incr i} {
set t [thread::create]
thread::send $t {package require Itcl}
lappend tl $t
set tm [time {set res [thread::send $t $tc]}]
puts $t=$res,$tm
}
foreach t $tl {
thread::release $t
}
exit
package require Thread
package require Itcl
proc dumplist {n cmd} {
set rc [list]
for {set i 0} {$i < $n} {incr i} {
lappend rc [eval $cmd]
}
return $rc
}
proc randstr {} {
set rc "x"
while {int(rand() * 5) != 0} {
append rc [lindex {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9} [expr {int(rand() * 36.0)}]]
}
return $rc
}
set tm [time {
set n 5
set list [dumplist $n {dumplist $n {dumplist $n {dumplist $n randstr}}}]
}]
puts "Creation: $tm"
itcl::class x {
private variable _var ""
public method vset {x} {
set _var $x
}
public method vget {} {
return ${_var}
}
}
x -ts x0
x0 vset $list
set tc {
format %d,%d,%d,%d \
[llength [x0 vget]] \
[llength [lindex [x0 vget] 0]] \
[llength [lindex [x0 vget] 0 0]] \
[llength [lindex [x0 vget] 0 0 0]]
}
set tm [time {set res [eval $tc]}]
puts R=$res,$tm
for {set i 0} {$i < 50} {incr i} {
set t [thread::create]
thread::send $t {package require Itcl}
lappend tl $t
set tm [time {set res [thread::send $t $tc]}]
puts $t=$res,$tm
}
foreach t $tl {
thread::release $t
}
exitEL: There is a segmentation fault when the threads are released. If the -wait flag is set to thread::release, they don't appear.
Category Itcl Category Threads
