Browse Source

zzzload lazy loading binary pkg in another thread - e.g twapi

master
Julian Noble 1 year ago
parent
commit
3eb6b3a972
  1. 12
      src/bootsupport/modules/punk/du-0.1.0.tm
  2. 41
      src/modules/flagfilter-0.3.tm
  3. 28
      src/modules/punk-0.1.tm
  4. 47
      src/modules/punk/du-999999.0a1.0.tm
  5. 16
      src/modules/punk/repl-0.1.tm
  6. 87
      src/modules/zzzload-999999.0a1.0.tm
  7. 3
      src/modules/zzzload-buildversion.txt

12
src/bootsupport/modules/punk/du-0.1.0.tm

@ -22,11 +22,13 @@ namespace eval punk::du {
variable has_twapi 0
}
if {"windows" eq $::tcl_platform(platform)} {
if {[catch {package require twapi}]} {
puts stderr "Warning: punk::du - unable to load twapi. Disk operations may be much slower on windows without the twapi package"
} else {
set punk::du::has_twapi 1
}
package require zzzload
zzzload::pkg_require twapi
#if {[catch {package require twapi}]} {
# puts stderr "Warning: punk::du - unable to load twapi. Disk operations may be much slower on windows without the twapi package"
#} else {
# set punk::du::has_twapi 1
#}
package require punk::winpath
}

41
src/modules/flagfilter-0.3.tm

@ -2597,47 +2597,6 @@ namespace eval flagfilter {
}
namespace eval flagfilter {
#The standard dict merge accepts multiple dicts with values from dicts to the right taking precedence.

28
src/modules/punk-0.1.tm

@ -3,11 +3,8 @@
namespace eval punk {
variable twapi_loader_tid
package require Thread
set twapi_loader_tid [thread::create]
thread::send -async $twapi_loader_tid {package require twapi}
package require zzzload
zzzload::pkg_require twapi
}
@ -156,6 +153,10 @@ namespace eval punk {
proc ::punk::uuid {} {
set has_twapi 0
if {"windows" eq $::tcl_platform(platform)} {
set loader [zzzload::pkg_wait twapi]
if {$loader in [list failed loading]} {
puts stderr "Unexpected problem during thread-load of pkg twapi - zzload::pkg_wait returned $loader"
}
if {![catch {package require twapi}]} {
set has_twapi 1
}
@ -5532,9 +5533,10 @@ namespace eval punk {
lappend chunklist [list stdout "[a+ white light]$out[a+]\n"]
lappend chunklist [list result $result]
set ::punk::last_run_display $chunklist
if {[llength [info commands ::repl::term::set_console_title]]} {
repl::term::set_console_title $location
}
}
return $result
} else {
#set a1 [lindex $args 0]
@ -6162,12 +6164,16 @@ namespace eval punk {
return $lines
}
proc pdict {d args} { ;# analogous to parray (except that it takes the dict as a value)
#set maxl [::tcl::mathfunc::max {*}[map {string length} [dict keys $d]]]
proc pdict {d {pattern *}} { ;# analogous to parray (except that it takes the dict as a value)
#maxl.= $d |@keys> .=/2 lmap v {string length $v} |> .=* tcl::mathfunc::max
set maxl [pipedata $d {dict keys $data} {list {*}$data ""} {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data} ]
dict for {key value} $d {
puts stdout [format "%-*s = %s" $maxl $key $value]
#set maxl [pipedata $d {dict keys $data} {list {*}$data ""} {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data} ]
#set maxl [::tcl::mathfunc::max {*}[map {string length} [dict keys $d]]]
set filtered_keys [lsort -dictionary [dict keys $d $pattern]]
if {[llength $filtered_keys]} {
set maxl [::tcl::mathfunc::max {*}[lmap v $filtered_keys {string length $v}]]
foreach key $filtered_keys {
puts stdout [format "%-*s = %s" $maxl $key [dict get $d $key]]
}
}
}

47
src/modules/punk/du-999999.0a1.0.tm

@ -24,11 +24,13 @@ namespace eval punk::du {
variable has_twapi 0
}
if {"windows" eq $::tcl_platform(platform)} {
if {[catch {package require twapi}]} {
puts stderr "Warning: punk::du - unable to load twapi. Disk operations may be much slower on windows without the twapi package"
} else {
set punk::du::has_twapi 1
}
package require zzzload
zzzload::pkg_require twapi
#if {[catch {package require twapi}]} {
# puts stderr "Warning: punk::du - unable to load twapi. Disk operations may be much slower on windows without the twapi package"
#} else {
# set punk::du::has_twapi 1
#}
#package require punk::winpath
}
@ -396,7 +398,7 @@ namespace eval punk::du {
variable functions_known [dict create]
#known functions from lib namespace
dict set functions_known du_dirlisting [list du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix]
dict set functions_known du_dirlisting [list du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided]
proc show_functions {} {
variable functions
@ -493,7 +495,7 @@ namespace eval punk::du {
}
#todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed?
namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix
namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided
# get listing without using unix-tools (may not be installed on the windows system)
# this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function)
# This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance
@ -1225,6 +1227,26 @@ namespace eval punk::du {
}
}
proc du_dirlisting_undecided {folderpath args} {
if {"windows" eq $::tcl_platform(platform)} {
set loadstate [zzzload::pkg_require twapi]
if {$loadstate ni [list loading failed]} {
package require twapi ;#should be fast once twapi dll loaded in zzzload thread
set ::punk::du::has_twapi 1
punk::du::active::set_active_function du_dirlisting du_dirlisting_twapi
tailcall du_dirlisting_twapi $folderpath {*}$args
} else {
if {$loadstate eq "failed"} {
puts stderr "punk::du defaulting to du_dirlisting_generic because twapi load failed"
set_active_function du_dirlisting du_dirlisting_generic
}
tailcall du_dirlisting_generic $folderpath {*}$args
}
} else {
set_active_function du_dirlisting du_dirlisting_unix
tailcall du_dirlisting_unix $folderpath {*}$args
}
}
}
@ -1247,15 +1269,8 @@ namespace eval punk::du {
variable functions_kown
upvar ::punk::du::has_twapi has_twapi
if {"windows" eq $::tcl_platform(platform)} {
if {$has_twapi} {
set_active_function du_dirlisting du_dirlisting_twapi
} else {
set_active_function du_dirlisting du_dirlisting_generic
}
} else {
set_active_function du_dirlisting du_dirlisting_unix
}
set_active_function du_dirlisting du_dirlisting_undecided
}

16
src/modules/punk/repl-0.1.tm

@ -129,8 +129,14 @@ namespace eval ::repl::term {
package require term::ansi::code::ctrl
if {$::tcl_platform(platform) eq "windows" && ![catch {package require twapi}]} {
#package require twapi
if {$::tcl_platform(platform) eq "windows"} {
package require zzzload
zzzload::pkg_require twapi
after idle [list after 2000 {
zzzload::pkg_wait twapi
if {![catch {package require twapi}]} {
proc ::repl::term::handler_console_control {args} {
puts -nonewline stdout .
flush stdout
@ -172,6 +178,12 @@ if {$::tcl_platform(platform) eq "windows" && ![catch {package require twapi}]}
proc ::repl::term::set_console_icon {name} {
#todo
}
#we can't yet emit from an event with proper prompt handling -
#repl::rputs stdout "twapi loaded"
} else {
repl::rputs stderr " Failed to load twapi"
}
}]
} else {
#TODO
proc ::repl::term::set_console_title {text} {

87
src/modules/zzzload-999999.0a1.0.tm

@ -0,0 +1,87 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application zzzload 999999.0a1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
package require Thread
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval zzzload {
variable loader_tid ;#thread id
set loader_tid [thread::create -preserved]
proc pkg_require {pkgname args} {
variable loader_tid
if {![tsv::exists zzzload_pkg $pkgname]} {
tsv::set zzzload_pkg $pkgname "loading"
tsv::set zzzload_pkg_mutex $pkgname [thread::mutex create]
set cond [thread::cond create]
tsv::set zzzload_pkg_cond $pkgname $cond
thread::send -async $loader_tid [string map [list <pkg> $pkgname <cond> $cond] {
if {![catch {package require <pkg>} ver]} {
tsv::set zzzload_pkg <pkg> $ver
} else {
tsv::set zzzload_pkg <pkg> "failed"
}
thread::cond notify <cond>
}]
return "loading"
} else {
return [tsv::get zzzload_pkg $pkgname]
}
}
proc pkg_wait {pkgname} {
set pkgstate [tsv::get zzzload_pkg $pkgname]
if {$pkgstate eq "loading"} {
set mutex [tsv::get zzzload_pkg_mutex $pkgname]
thread::mutex lock $mutex
set cond [tsv::get zzzload_pkg_cond $pkgname]
while {[tsv::get zzzload_pkg $pkgname] eq "loading"} {
thread::cond wait $cond $mutex 3000
}
set result [tsv::get zzzload_pkg $pkgname]
thread::mutex unlock $mutex
return $result
} else {
return $pkgstate
}
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide zzzload [namespace eval zzzload {
variable version
set version 999999.0a1.0
}]
return

3
src/modules/zzzload-buildversion.txt

@ -0,0 +1,3 @@
0.1.0
#First line must be a semantic version number
#all other lines are ignored.
Loading…
Cancel
Save