## tpool (pula watkow) + sqlite (wspoldzielona pamiec), 07.2021
# + sqlite i tclsqlite docs:
# https://www.sqlite.org/tclsqlite.html
# https://www.sqlite.org/lang.html SQL w sqlite
# https://www.sqlite.org/c3ref/c_abort.html kody błędów
# + tcl Thread/tpool docs:
# http://www.tcl.tk/man/tcl8.6/ThreadCmd/contents.htm
# http://www.tcl.tk/man/tcl8.6/ThreadCmd/thread.htm
# http://www.tcl.tk/man/tcl8.6/ThreadCmd/tpool.htm
# + baza sqlite jako wspoldzielona pamiec watkow...
# czy to jest dobry pomysl ???
#
package require Thread
#% 2.8.4
package re sqlite3
#% 3.25.3
sqlite3 db "file:qqq1?mode=memory&cache=shared" -uri 1
#db close
#catch {db qqq } err; set err
set licz_wier 1000
#% 1000
# (re)definicja tabeli R1 i jej wypelnianie...
catch {db eval {drop table R1}}
db eval {create table R1 (ID integer primary key, p1 text, p2 text, p3 text)}
for {set j 0} {$j < $licz_wier} {incr j} {
db eval {insert into R1 values ($j, $j, 2*$j, 0)}
}
# pokazywanie tabeli...
.output.t delete 1.0 end
db eval {select * from R1} q {_puts "ID=$q(ID), p1=$q(p1), p2=$q(p2), p3=$q(p3)"}
# definicja puli watkow...
set tp1 [tpool::create -maxworkers 8 -minworkers 8 -initcmd [
string map "@th [thread::id]" {
set th @th
package re sqlite3
sqlite3 db "file:qqq1?mode=memory&cache=shared" -uri 1
# proc naprawiajace blad lock/busy...
proc sq_powt3 {db kod} { # powtarza eval
upvar sq_licz licz; set licz 0
while {[catch "uplevel {$db eval {$kod}}" err]} {
if {[$db errorcode] in {5 6}} {
incr licz
} {error "sq_powt3: $err"}
}
return $err
}
}]]
#% tpool0xa1d0568
# !!! do tego miejsca wykonaj !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# wysylanie zadan do puli watkow...
.output.t delete 1.0 end
time {
for {set i 0} {$i<$licz_wier} {incr i} {
tpool::post -detached -nowait $tp1 [
string map "@i $i" {
thread::send -async $th "_puts {[clock microseconds], [thread::id], i=@i, ///start///}"
set p1 [sq_powt3 db {select p1 from R1 where ID=@i}]
set it1 $sq_licz
sq_powt3 db {update R1 set p3 = p1 where ID=@i}
set it2 $sq_licz
set p3 [sq_powt3 db {select p3 from R1 where ID=@i}]
set it3 $sq_licz
thread::send -async $th "_puts {[clock microseconds], [thread::id], i=@i, ///koniec///, $it1, $it2, $it3}"
}]}}
db eval {select count(ID) from R1 where p1 = p3}
# + powinno byc 1000
set t1 [string range [lindex [.output.t get 1.0 {1.0 + 1 line}] 0] 0 end-1]
set ii [.output.t index {end - 2 line}]
set t2 [string range [lindex [.output.t get $ii "$ii + 1 line"] 0] 0 end-1]
expr $t2-$t1
# ^ czas wykonania obliczen
exit