jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

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

master
Julian Noble 12 months ago
parent
a317ca047a
commit
3eb6b3a972
7 changed files with 199 additions and 115 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 12
      src/bootsupport/modules/punk/du-0.1.0.tm
  2. 41
      src/modules/flagfilter-0.3.tm
  3. 30
      src/modules/punk-0.1.tm
  4. 47
      src/modules/punk/du-999999.0a1.0.tm
  5. 94
      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
Unescape View File

@ -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
Unescape View File

@ -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.

30
src/modules/punk-0.1.tm
Unescape View File

@ -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,8 +5533,9 @@ namespace eval punk {
lappend chunklist [list stdout "[a+ white light]$out[a+]\n"]
lappend chunklist [list result $result]
set ::punk::last_run_display $chunklist
repl::term::set_console_title $location
if {[llength [info commands ::repl::term::set_console_title]]} {
repl::term::set_console_title $location
}
}
return $result
} else {
@ -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
Unescape View File

@ -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
}

94
src/modules/punk/repl-0.1.tm
Unescape View File

@ -129,49 +129,61 @@ namespace eval ::repl::term {
package require term::ansi::code::ctrl
if {$::tcl_platform(platform) eq "windows" && ![catch {package require twapi}]} {
#package require twapi
proc ::repl::term::handler_console_control {args} {
puts -nonewline stdout .
flush stdout
incr ::repl::signal_control_c
#rputs stderr "* console_control: $args"
#return 0 to fall through to default handler
if {$::repl::signal_control_c <= 2} {
set remaining [expr {3 - $::repl::signal_control_c}]
puts stderr "ctrl-c (perform $remaining more to quit, enter to return to repl)"
flush stderr
return 1
} elseif {$::repl::signal_control_c == 3} {
puts stderr "ctrl-c x3 received - quitting"
flush stderr
after 25
quit
return 1
} elseif {$::repl::signal_control_c == 4} {
puts stderr "ctrl-c x4 received - one more to hard exit"
flush stderr
return 1
} elseif {$::repl::signal_control_c >= 5} {
#a script that allows events to be processed could still be running
puts stderr "ctrl-c x5 received - hard exit"
flush stderr
after 25
exit 499 ;# HTTP 'client closed request' - just for the hell of it.
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
incr ::repl::signal_control_c
#rputs stderr "* console_control: $args"
#return 0 to fall through to default handler
if {$::repl::signal_control_c <= 2} {
set remaining [expr {3 - $::repl::signal_control_c}]
puts stderr "ctrl-c (perform $remaining more to quit, enter to return to repl)"
flush stderr
return 1
} elseif {$::repl::signal_control_c == 3} {
puts stderr "ctrl-c x3 received - quitting"
flush stderr
after 25
quit
return 1
} elseif {$::repl::signal_control_c == 4} {
puts stderr "ctrl-c x4 received - one more to hard exit"
flush stderr
return 1
} elseif {$::repl::signal_control_c >= 5} {
#a script that allows events to be processed could still be running
puts stderr "ctrl-c x5 received - hard exit"
flush stderr
after 25
exit 499 ;# HTTP 'client closed request' - just for the hell of it.
} else {
puts stderr "ctrl-c $::repl::signal_control_c received"
flush stderr
return 0
}
}
twapi::set_console_control_handler ::repl::term::handler_console_control
proc ::repl::term::set_console_title {text} {
#twapi::set_console_title $text
puts -nonewline [term::ansi::code::ctrl::title $text]
}
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 {
puts stderr "ctrl-c $::repl::signal_control_c received"
flush stderr
return 0
repl::rputs stderr " Failed to load twapi"
}
}
twapi::set_console_control_handler ::repl::term::handler_console_control
proc ::repl::term::set_console_title {text} {
#twapi::set_console_title $text
puts -nonewline [term::ansi::code::ctrl::title $text]
}
proc ::repl::term::set_console_icon {name} {
#todo
}
}]
} else {
#TODO
proc ::repl::term::set_console_title {text} {

87
src/modules/zzzload-999999.0a1.0.tm
Unescape View File

@ -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
Unescape View File

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