From 3eb6b3a972c2f00deb54e3da89c53c7a02f330e9 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 4 Oct 2023 14:47:32 +1100 Subject: [PATCH] zzzload lazy loading binary pkg in another thread - e.g twapi --- src/bootsupport/modules/punk/du-0.1.0.tm | 12 +-- src/modules/flagfilter-0.3.tm | 41 ----------- src/modules/punk-0.1.tm | 30 +++++--- src/modules/punk/du-999999.0a1.0.tm | 47 ++++++++---- src/modules/punk/repl-0.1.tm | 94 +++++++++++++----------- src/modules/zzzload-999999.0a1.0.tm | 87 ++++++++++++++++++++++ src/modules/zzzload-buildversion.txt | 3 + 7 files changed, 199 insertions(+), 115 deletions(-) create mode 100644 src/modules/zzzload-999999.0a1.0.tm create mode 100644 src/modules/zzzload-buildversion.txt diff --git a/src/bootsupport/modules/punk/du-0.1.0.tm b/src/bootsupport/modules/punk/du-0.1.0.tm index c908fa3f..2296702c 100644 --- a/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/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 } diff --git a/src/modules/flagfilter-0.3.tm b/src/modules/flagfilter-0.3.tm index de713a35..bd63cebe 100644 --- a/src/modules/flagfilter-0.3.tm +++ b/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. diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 425a30ca..6380474e 100644 --- a/src/modules/punk-0.1.tm +++ b/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,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]] + } } } diff --git a/src/modules/punk/du-999999.0a1.0.tm b/src/modules/punk/du-999999.0a1.0.tm index 91d615b3..03cfac39 100644 --- a/src/modules/punk/du-999999.0a1.0.tm +++ b/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 + } diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 9fc3cab7..57f273bf 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -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} { diff --git a/src/modules/zzzload-999999.0a1.0.tm b/src/modules/zzzload-999999.0a1.0.tm new file mode 100644 index 00000000..2cddc6df --- /dev/null +++ b/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 -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 +# @@ 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 $pkgname $cond] { + if {![catch {package require } ver]} { + tsv::set zzzload_pkg $ver + } else { + tsv::set zzzload_pkg "failed" + } + thread::cond notify + }] + 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 \ No newline at end of file diff --git a/src/modules/zzzload-buildversion.txt b/src/modules/zzzload-buildversion.txt new file mode 100644 index 00000000..f47d01c8 --- /dev/null +++ b/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.