jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1226 Commits
1 Branch
1 Tag
193 MiB
 
 
 
 
 
 
Tree: 5e9f1c75fc
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '5e9f1c75fc'
${ noResults }
punkshell/src/make.tcl

7763 lines
415 KiB
Raw Blame History

# tcl
#
# punkboot - make any tclkits and modules in <projectdir>/src folders and place them and associated data files/scripts in the parent folder of src.
#e.g in 'bin' and 'modules' folders at same level as 'src' folder.
# ---------------------------------------------------------------------------
# Terminal-aware colour/ANSI policy (G-113) - evaluated before any output.
# Precedence:
# 1. NO_COLOR set (any value) -> colour OFF (always wins; punk::ansi
# NO_COLOR semantics: colour codes stripped, non-colour effects like bold
# may remain when output goes to a terminal)
# 2. PUNK_FORCE_COLOR / FORCE_COLOR set -> ANSI ON even when piped
# (a value of 0/false/no/off is treated as not-set, per ecosystem convention)
# 3. stdout tty probe -> colour ON only when stdout is a
# terminal channel: -winsize option present (Tcl 8.7+/9 terminal channels,
# mirroring the stdin_is_interactive -inputmode precedent), or - Tcl 8.6 on
# windows - stdout -encoding reporting 'unicode' (utf-16), which only the
# 8.6 windows console channel does (pipes/files get the system encoding).
# Piped/redirected stdout (probe fails, no force) additionally pushes a strip
# transform so the output is fully ESC-free - machine consumers get plain text
# no matter which emitter produced it (punk::ansi's colour_disabled contract
# deliberately retains non-colour SGR effects, and module-side emitters like
# punkcheck summaries follow that contract - the transform is the single choke
# point that guarantees zero ESC bytes). The push is PER CHANNEL and skips any
# utf-16-class channel (a byte-level strip corrupts utf-16 - ESC arrives as
# 1B 00; such a channel is an 8.6 console, i.e. a real terminal, and keeps its
# ANSI) - e.g 'make.tcl ... > file' from an 8.6 console wraps stdout only.
# Tcl 8.6 on unix has no boot-phase tty probe at all: the fail direction is
# plain/OFF (safe for piped/captured agent runs - unlike stdin's
# assume-interactive; use the force env vars for 8.6 unix interactive colour).
# stderr colour follows the same single stdout-keyed decision.
# The colour switch is ::punk::console::colour_disabled; when punk::ansi is
# already loaded (punk-exe-hosted runs) its sgr cache is cleared per that
# module's contract ("whatever function disables or re-enables colour should
# have made a call to punk::ansi::sgr_cache -action clear").
# ::punkboot::colour_mode records the decision: one of
# tty | forced | nocolor | piped-plain | tcl86-plain
# ---------------------------------------------------------------------------
namespace eval ::punkboot {
variable colour_mode ""
}
namespace eval ::punkboot::ansistrip {
#Write-side channel transform stripping all ANSI escape sequences (CSI incl.
#SGR, OSC with BEL/ST terminators, and two-char ESC sequences). Handles
#sequences split across write chunks via a per-channel carry buffer; an
#unterminated sequence held at flush/finalize time is dropped (it is an
#incomplete ANSI sequence - dropping it IS stripping it).
variable carry [dict create]
variable re_complete {\x1b(?:\[[0-9;:<=>?]*[ -/]*[@-~]|\][^\x07\x1b]*(?:\x07|\x1b\\)|[@-Z\\^_])}
proc strip {chanid data} {
variable carry
variable re_complete
if {[dict exists $carry $chanid]} {
set data "[dict get $carry $chanid]$data"
dict unset carry $chanid
}
#hold back a trailing incomplete escape sequence (conservative: from the
#last ESC onward, if it is not a complete sequence it may be a prefix of
#one still being written)
set idx [string last \x1b $data]
if {$idx >= 0} {
set tail [string range $data $idx end]
if {![regexp -- "^${re_complete}" $tail]} {
dict set carry $chanid $tail
set data [string range $data 0 $idx-1]
}
}
regsub -all -- $re_complete $data {} data
return $data
}
proc transchan {op chanid args} {
variable carry
switch -- $op {
initialize {
return [list initialize finalize write flush clear]
}
write {
return [strip $chanid [lindex $args 0]]
}
flush {
return ""
}
clear -
finalize {
dict unset carry $chanid
return
}
}
}
}
apply {{} {
set force 0
foreach fvar {PUNK_FORCE_COLOR FORCE_COLOR} {
if {[info exists ::env($fvar)] && $::env($fvar) ni {0 false FALSE no NO off OFF}} {
set force 1
break
}
}
set stdout_is_tty [expr {![catch {chan configure stdout -winsize}]}]
if {!$stdout_is_tty && ![package vsatisfies [package provide Tcl] 8.7-]} {
#Tcl 8.6 tty signatures (no -winsize/-inputmode exists pre-8.7):
# - windows: 8.6's CONSOLE channels are the only ones that report
# -encoding unicode (utf-16; pipes/files get the system encoding). This
# both restores interactive colour on 8.6 consoles and is load-bearing
# for the ansistrip transform below: the byte-level strip must never sit
# on a utf-16 channel (ESC arrives as 1B 00 - sequences pass unstripped
# and the hold-back logic defers/drops real content; field defect
# 2026-07-25 mangling punk86/punksys console help output).
# - unix-class (linux/WSL/mac AND msys2/cygwin-runtime builds, which report
# tcl_platform(platform) unix even on a windows machine): the tty channel
# type is isatty-gated and exposes the serial/tty options (-mode etc) on
# real terminals only - pipes/files lack them. Verified: WSL 8.6.14 pty
# -mode present / piped absent; msys2 8.6.12 interactive present / piped
# absent. (-mode on a windows 8.6 stdout would mean a serial channel -
# terminal-equivalent for colour purposes.)
if {[chan configure stdout -encoding] eq "unicode"} {
set stdout_is_tty 1
} elseif {![catch {chan configure stdout -mode}]} {
set stdout_is_tty 1
}
}
if {[info exists ::env(NO_COLOR)]} {
namespace eval ::punk::console {variable colour_disabled 1}
set ::punkboot::colour_mode nocolor
} elseif {$force} {
namespace eval ::punk::console {variable colour_disabled 0}
set ::punkboot::colour_mode forced
} elseif {$stdout_is_tty} {
namespace eval ::punk::console {variable colour_disabled 0}
set ::punkboot::colour_mode tty
} else {
namespace eval ::punk::console {variable colour_disabled 1}
if {[package vsatisfies [package provide Tcl] 8.7-]} {
set ::punkboot::colour_mode piped-plain
} else {
set ::punkboot::colour_mode tcl86-plain
}
}
#zero-ESC guarantee for piped/unknown output unless the caller forced ANSI on.
#(NO_COLOR keeps punk::ansi's documented colour-only-stripping semantics on a
#terminal; a NO_COLOR run with piped stdout still gets the full strip.)
#Per-channel: a byte-level strip must never sit on a utf-16-class channel (the
#8.6 windows console encoding) - e.g 'make.tcl ... > file' from an 8.6 console
#leaves stderr ON the console; that channel is a real terminal, so it keeps its
#ANSI rather than getting corrupted. ::punkboot::ansistrip_pushed records the
#channels actually wrapped (the shell subcommand pops exactly those).
set ::punkboot::ansistrip_pushed [list]
if {!$force && !$stdout_is_tty} {
foreach _ch {stdout stderr} {
if {[chan configure $_ch -encoding] ni {unicode utf-16 utf-16le utf-16be}} {
chan push $_ch ::punkboot::ansistrip::transchan
lappend ::punkboot::ansistrip_pushed $_ch
}
}
}
#punk-exe-hosted runs arrive with punk::ansi pre-loaded and a warm sgr cache
#generated under the kit's own colour state - honour the module's contract.
if {[package provide punk::ansi] ne ""} {
catch {punk::ansi::sgr_cache -action clear}
}
if {[info exists ::env(PUNKBOOT_COLOUR_DEBUG)]} {
puts stderr "punkboot colour policy: mode=$::punkboot::colour_mode colour_disabled=$::punk::console::colour_disabled ansistrip=[expr {[llength $::punkboot::ansistrip_pushed] ? [join $::punkboot::ansistrip_pushed +] : 0}]"
}
}}
# Colour-policy gate for raw-SGR emission sites that can run before
# define_global_ansi / punk::ansi are available (early package-load
# diagnostics and kit-build warnings). Returns the SGR sequence, or an empty
# string when colour is disabled. Empty/omitted params give the reset.
proc ::punkboot::sgr {{sgrparams ""}} {
if {[info exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} {
return ""
}
return "\x1b\[${sgrparams}m"
}
set hashline "# ## ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ###"
puts $hashline
puts " Punk Boot"
puts $hashline\n
package prefer latest
lassign [split [info tclversion] .] tclmajorv tclminorv
global A ;#UI Ansi code array
array set A {}
namespace eval ::punkboot {
variable scriptfolder [file normalize [file dirname [info script]]]
variable foldername [file tail $scriptfolder]
variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list]
variable help_flags [list -help --help /? -h]
variable known_commands [list bakehouse packages modules libs bake bakelist vfslibs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion workflow buildsuite tool project vfs]
}
namespace eval ::punkboot::lib {
#for some purposes (whether a source folder is likely to have any useful content) we are interested in non dotfile/dotfolder immediate contents of a folder, but not whether a particular platform
#considers them hidden or not.
proc folder_nondotted_children {folder} {
set normfolder [file normalize $folder]
if {![file isdirectory $normfolder]} {error "punkboot::lib::folder_nondotted_children error. Supplied folder '$folder' is not a directory"}
set contents [glob -nocomplain -dir $folder -tails *]
#some platforms (windows) return dotted entries with *, although most don't
set nondotted_tails [lsearch -all -inline -not $contents .*]
return [lmap ftail $nondotted_tails {file join $folder $ftail}]
}
proc folder_nondotted_folders {folder} {
set normfolder [file normalize $folder]
if {![file isdirectory $normfolder]} {error "punkboot::lib::folder_nondotted_folders error. Supplied folder '$folder' is not a directory"}
set contents [glob -nocomplain -dir $folder -types d -tails *]
#some platforms (windows) return dotted entries with *, although most don't
set nondotted_tails [lsearch -all -inline -not $contents .*]
return [lmap ftail $nondotted_tails {file join $folder $ftail}]
}
proc folder_nondotted_files {folder} {
set normfolder [file normalize $folder]
if {![file isdirectory $normfolder]} {error "punkboot::lib::folder_nondotted_files error. Supplied folder '$folder' is not a directory"}
set contents [glob -nocomplain -dir $folder -types f $folder -tails *]
#some platforms (windows) return dotted entries with *, although most don't
set nondotted_tails [lsearch -all -inline -not $contents .*]
return [lmap ftail $nondotted_tails {file join $folder $ftail}]
}
proc tm_version_isvalid {versionpart} {
#Needs to be suitable for use with Tcl's 'package vcompare'
if {![catch [list package vcompare $versionpart $versionpart]]} {
return 1
} else {
return 0
}
}
proc tm_version_major {version} {
if {![tm_version_isvalid $version]} {
error "Invalid version '$version' is not a proper Tcl module version number"
}
set firstpart [lindex [split $version .] 0]
#check for a/b in first segment
if {[string is integer -strict $firstpart]} {
return $firstpart
}
if {[string first a $firstpart] > 0} {
return [lindex [split $firstpart a] 0]
}
if {[string first b $firstpart] > 0} {
return [lindex [split $firstpart b] 0]
}
error "tm_version_major unable to determine major version from version number '$version'"
}
proc tm_version_canonical {ver} {
#accepts a single valid version only - not a bounded or unbounded spec
if {![tm_version_isvalid $ver]} {
error "tm_version_canonical version '$ver' is not valid for a package version"
}
set parts [split $ver .]
set newparts [list]
foreach o $parts {
set trimmed [string trimleft $o 0]
set firstnonzero [string index $trimmed 0]
switch -exact -- $firstnonzero {
"" {
lappend newparts 0
}
a - b {
#e.g 000bnnnn -> bnnnnn
set tailtrimmed [string trimleft [string range $trimmed 1 end] 0]
if {$tailtrimmed eq ""} {
set tailtrimmed 0
}
lappend newparts 0$firstnonzero$tailtrimmed
}
default {
#digit
if {[string is integer -strict $trimmed]} {
#e.g 0100 -> 100
lappend newparts $trimmed
} else {
#e.g 0100b003 -> 100b003 (still need to process tail)
if {[set apos [string first a $trimmed]] > 0} {
set lhs [string range $trimmed 0 $apos-1] ;#assert lhs non-empty and only digits or wouldn't be in this branch
set rhs [string range $trimmed $apos+1 end] ;#assert rhs non-empty and only digits
set rhs [string trimleft $rhs 0]
if {$rhs eq ""} {
set rhs 0
}
lappend newparts ${lhs}a${rhs}
} elseif {[set bpos [string first b $trimmed]] > 0} {
set lhs [string range $trimmed 0 $bpos-1] ;#assert lhs non-empty and only digits or wouldn't be in this branch
set rhs [string range $trimmed $bpos+1 end] ;#assert rhs non-empty and only digits
set rhs [string trimleft $rhs 0]
if {$rhs eq ""} {
set rhs 0
}
lappend newparts ${lhs}b${rhs}
} else {
#assert - shouldn't get here trimmed val should have been empty, an int or contained an a or b
error "tm_version_canonical error - trimfail - unexpected"
}
}
}
}
}
return [join $newparts .]
}
proc tm_version_required_canonical {versionspec} {
#also trim leading zero from any dottedpart?
#Tcl *allows* leading zeros in any of the dotted parts - but they are not significant.
#e.g 1.01 is equivalent to 1.1 and 01.001
#also 1b3 == 1b0003
if {[string trim $versionspec] eq ""} {return ""} ;#unspecified = any version
set errmsg "punkboot::lib::tm_version_required_canonical - invalid version specification"
if {[string first - $versionspec] < 0} {
#no dash
#looks like a minbounded version (ie a single version with no dash) convert to min-max form
set from $versionspec
if {![::punkboot::lib::tm_version_isvalid $from]} {
error "$errmsg '$versionpec'"
}
if {![catch {::punkboot::lib::tm_version_major $from} majorv]} {
set from [tm_version_canonical $from]
return "${from}-[expr {$majorv +1}]"
} else {
error "$errmsg '$versionspec'"
}
} else {
# min- or min-max
#validation and canonicalisation (strip leading zeroes from each segment, including either side of a or b)
set parts [split $versionspec -] ;#we expect only 2 parts
lassign $parts from to
if {![::punkboot::lib::tm_version_isvalid $from]} {
error "$errmsg '$versionspec'"
}
set from [tm_version_canonical $from]
if {[llength $parts] == 2} {
if {$to ne ""} {
if {![::punkboot::lib::tm_version_isvalid $to]} {
error "$errmsg '$versionspec'"
}
set to [tm_version_canonical $to]
return $from-$to
} else {
return $from-
}
} else {
error "$errmsg '$versionspec'"
}
error "tm_version_required_canonical should have already returned a canonicalised versionspec - or produced an error with reason before this point"
}
}
#This is somewhat ugly - but we don't want to do any 'package require' operations at this stage
# even for something that is available in tcl_library.
#review
proc platform_generic {} {
#platform::generic - snipped straight from platform package
global tcl_platform
set plat [string tolower [lindex $tcl_platform(os) 0]]
set cpu $tcl_platform(machine)
switch -glob -- $cpu {
sun4* {
set cpu sparc
}
intel -
ia32* -
i*86* {
set cpu ix86
}
x86_64 {
if {$tcl_platform(wordSize) == 4} {
# See Example <1> at the top of this file.
set cpu ix86
}
}
ppc -
"Power*" {
set cpu powerpc
}
"arm*" {
set cpu arm
}
ia64 {
if {$tcl_platform(wordSize) == 4} {
append cpu _32
}
}
}
switch -glob -- $plat {
windows {
if {$tcl_platform(platform) == "unix"} {
set plat cygwin
} else {
set plat win32
}
if {$cpu eq "amd64"} {
# Do not check wordSize, win32-x64 is an IL32P64 platform.
set cpu x86_64
}
}
sunos {
set plat solaris
if {[string match "ix86" $cpu]} {
if {$tcl_platform(wordSize) == 8} {
set cpu x86_64
}
} elseif {![string match "ia64*" $cpu]} {
# sparc
if {$tcl_platform(wordSize) == 8} {
append cpu 64
}
}
}
darwin {
set plat macosx
# Correctly identify the cpu when running as a 64bit
# process on a machine with a 32bit kernel
if {$cpu eq "ix86"} {
if {$tcl_platform(wordSize) == 8} {
set cpu x86_64
}
}
}
aix {
set cpu powerpc
if {$tcl_platform(wordSize) == 8} {
append cpu 64
}
}
hp-ux {
set plat hpux
if {![string match "ia64*" $cpu]} {
set cpu parisc
if {$tcl_platform(wordSize) == 8} {
append cpu 64
}
}
}
osf1 {
set plat tru64
}
default {
set plat [lindex [split $plat _-] 0]
}
}
return "${plat}-${cpu}"
}
proc platform_normalize_os {os} {
#INLINE COPY of punk::platform::normalize_os - see platform_punk below.
switch -glob -- [string tolower $os] {
macos {return macosx}
msys - msys_nt-* {return msys}
mingw32 - mingw64 - mingw_nt-* - mingw32_nt-* - mingw64_nt-* {return msys}
ucrt64 - ucrt64_nt-* {return msys}
clang32 - clang64 - clangarm64 - clang32_nt-* - clang64_nt-* - clangarm64_nt-* {return msys}
cygwin_nt-* {return cygwin}
}
return $os
}
proc platform_punk {} {
#canonical punkshell platform-dir name: platform_generic normalized.
#INLINE COPY of punk::platform::normalize (src/modules/punk/platform-*.tm;
#'help platforms' documents the canon) - the boot stage cannot package
#require, so keep this mapping in sync with that module:
#amd64->x86_64, aarch64->arm64, macos->macosx, macosx arm->arm64,
#msys2 family (mingw64/mingw32/ucrt64/clang*) -> msys, CYGWIN_NT -> cygwin.
set parts [split [platform_generic] -]
set cpu [lindex $parts end]
set os [join [lrange $parts 0 end-1] -]
set os [platform_normalize_os $os]
switch -- $cpu {
amd64 {set cpu x86_64}
aarch64 {set cpu arm64}
arm {if {$os eq "macosx"} {set cpu arm64}}
}
return "${os}-${cpu}"
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# G-122 host/target platform split.
# platform_punk answers "what is THIS tclsh" (the HOST canon). Everything a
# build EMITS is a separate question keyed by TARGET: which bin/runtime/<tier>
# store holds the runtime, whether artifacts carry .exe, and which process
# tooling can see/kill a running artifact. The two diverge for the whole
# cygwin family: an msys2/cygwin-runtime tclsh on windows reports
# tcl_platform(platform) 'unix' and canonizes as msys-x86_64/cygwin-x86_64,
# yet the kits it bakes are ordinary win32-x86_64 .exe binaries that only
# tasklist/taskkill can manage (msys 'ps' sees only msys-descendant
# processes). Host process semantics - copy commands, path handling, prompts,
# filesystem case rules - stay keyed to the host.
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#os token of a canonical platform-dir name (win32-x86_64 -> win32; macosx -> macosx)
proc platform_os {platform} {
set parts [split $platform -]
if {[llength $parts] < 2} {
return $platform
}
return [join [lrange $parts 0 end-1] -]
}
#cpu token of a canonical platform-dir name ("" for single-token names like macosx)
proc platform_cpu {platform} {
set parts [split $platform -]
if {[llength $parts] < 2} {
return ""
}
return [lindex $parts end]
}
#posix-personality runtimes hosted on windows (msys2 / cygwin)
proc platform_is_cygwin_family {platform} {
return [expr {[platform_os $platform] in {msys cygwin}}]
}
#Windows-family platforms: native win32 AND the cygwin-family personalities.
#They share what matters to a build: executables are .exe files and running
#processes are windows processes (tasklist/taskkill), whatever tcl_platform says.
proc platform_is_windows_family {platform} {
return [expr {[platform_os $platform] in {win32 msys cygwin}}]
}
#Default TARGET platform for a host canon. A cygwin-family host builds native
#windows kits (there is no separate msys kit lineage - third-party msys
#runtimes are addressed by an explicit per-entry target instead).
proc platform_target_default {hostplatform} {
if {[platform_is_cygwin_family $hostplatform]} {
set cpu [platform_cpu $hostplatform]
if {$cpu eq ""} {set cpu x86_64}
return "win32-$cpu"
}
return $hostplatform
}
#bin/runtime store tier folder name for a target: macOS runtimes are universal
#(multi-arch) binaries kept in one 'macosx' folder - see punk::platform.
proc platform_store_tier {target} {
if {[string match "macosx-*" $target]} {
return macosx
}
return $target
}
#executable filename suffix artifacts for this target carry
proc platform_exe_suffix {target} {
if {[platform_is_windows_family $target]} {
return ".exe"
}
return ""
}
#which process tooling manages a running artifact of this platform
proc platform_process_family {platform} {
if {[platform_is_windows_family $platform]} {
return windows
}
return posix
}
#A target platform name must look like a platform-dir name so it can address a
#store tier. Returns "" when acceptable, else a reason string.
proc platform_name_problem {platform} {
if {$platform eq ""} {
return "empty"
}
if {[regexp {[\\/:*?\"<>|]} $platform]} {
return "not a platform-dir name (contains a path/wildcard character)"
}
if {[llength [split $platform -]] < 2 && $platform ne "macosx"} {
return "not an <os>-<cpu> platform-dir name ('help platforms' lists the canon)"
}
return ""
}
}
#------------------------------------------------------------------------------
# Bootsupport staleness helpers — self-contained Tcl, no punk package deps.
# These run in the early boot phase before punk packages are guaranteed loaded
# (modeled on punk::lib::askuser but without punk::console / raw-mode deps).
#------------------------------------------------------------------------------
# Classify the version delta between an old (bootsupport) and new (source)
# semver as "major", "minor", or "patch".
# Caller must verify new_ver > old_ver via `package vcompare` first.
proc ::punkboot::lib::bootsupport_bump_level {old_ver new_ver} {
set op [split $old_ver .]
set np [split $new_ver .]
while {[llength $op] < 3} {lappend op 0}
while {[llength $np] < 3} {lappend np 0}
set op [lmap s $op {
set n [scan $s %d]
expr {[string is integer -strict $n] ? $n : 0}
}]
set np [lmap s $np {
set n [scan $s %d]
expr {[string is integer -strict $n] ? $n : 0}
}]
lassign $op o_major o_minor o_patch
lassign $np n_major n_minor n_patch
if {$n_major > $o_major} {return "major"}
if {$n_minor > $o_minor} {return "minor"}
return "patch"
}
# stdin interactivity probe for the confirmation-prompt policy (G-030).
# Tcl 8.7+/9: -inputmode is supported only on terminal channels, so a successful
# query means stdin is a console. Under Tcl 8.6 there is no -inputmode anywhere and
# no reliable pure-Tcl tty test in the boot phase - we return 1 (assume interactive,
# the pre-G-030 behaviour of reading stdin) so a real 8.6 console still gets its
# prompt. Piped/non-interactive runs under 8.6 should pass -confirm explicitly.
proc ::punkboot::lib::stdin_is_interactive {} {
if {![catch {chan configure stdin -inputmode}]} {
return 1
}
if {[package vsatisfies [package provide Tcl] 8.7-]} {
return 0
}
return 1
}
# Self-contained y/N prompt. Returns 1 for y/yes (case-insensitive), 0 otherwise.
# Used by the staleness abort path to ask the user whether to proceed past a
# minor-version bump. Default is No (Enter = abort) so accidental Enter is safe.
proc ::punkboot::lib::bootsupport_prompt_yesno {prompt} {
puts stdout $prompt
puts -nonewline stdout "Proceed anyway? (y/N) "
flush stdout
set stdin_state [chan configure stdin]
try {
chan configure stdin -blocking 1
set answer [string tolower [string trim [gets stdin]]]
} finally {
chan configure stdin -blocking [dict get $stdin_state -blocking]
}
return [expr {$answer eq "y" || $answer eq "yes"}]
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# Parsed kit-mapping model (G-121). One reader for src/runtime/mapvfs.config -
# the 'bake' kit machinery, the 'bakelist' report and the bake/bakelist argdoc
# choices all consume the model these helpers return, never the file format
# directly, so a config-format change (G-024 toml direction) swaps in underneath
# by reimplementing mapvfs_parse alone.
#
# mapvfs_parse: pure parse - no output, no exits. Every store address, presence
# probe and artifact suffix it computes is keyed by the entry's TARGET platform
# (G-122), never by the driving tclsh's personality: $rtbase is the store ROOT
# (bin/runtime) and each entry addresses $rtbase/<its own tier>. Returns a dict:
# exists 0|1 (mapfile present)
# mapfile path as supplied
# default_target target platform for entries that declare none
# runtime_vfs_map runtime -> raw vfs_specs as listed (appname/type/target may be "")
# vfs_runtime_map vfstail -> list of {runtime appname type target smokerequires}
# (defaults applied; only vfs folders that exist on disk - matching
# the historical inline parse the kit loop was built around;
# smokerequires is the G-133 smoke-require package list, may be "")
# runtime_target runtime -> resolved target platform (all runtimes, mapped order)
# missing names of referenced-but-absent runtimes/vfs folders
# warnings warning lines in encounter order, ready to print verbatim
# (missing-item lines carry their historical WARNING: prefix)
# badentries subset of warnings: malformed entry lines (these have no kit
# record to carry them, so bakelist prints them; missing-item
# warnings are instead surfaced as per-row state there)
# configerrors fatal config problems (duplicate runtime line; unusable or
# self-contradicting target platform; caller decides whether to
# abort - the bake path keeps its historical exit 3)
proc ::punkboot::lib::mapvfs_parse {mapfile rtbase sourcefolder default_target} {
set model [dict create\
exists 0\
mapfile $mapfile\
default_target $default_target\
runtime_vfs_map [dict create]\
vfs_runtime_map [dict create]\
runtime_target [dict create]\
missing [list]\
warnings [list]\
badentries [list]\
configerrors [list]\
]
if {![file exists $mapfile]} {
return $model
}
dict set model exists 1
set fdmap [open $mapfile r]
fconfigure $fdmap -translation binary
set mapdata [read $fdmap]
close $fdmap
set mapdata [string map [list \r\n \n] $mapdata]
set runtime_vfs_map [dict create]
set vfs_runtime_map [dict create]
set runtime_target [dict create]
set missing [list]
set warnings [list]
set badentries [list]
set configerrors [list]
foreach ln [split $mapdata \n] {
set ln [string trim $ln]
if {$ln eq "" || [string match #* $ln]} {
continue
}
set vfs_specs [lassign $ln runtime]
if {[string match *.exe $runtime]} {
#.exe is superfluous but allowed
#drop windows .exe suffix so same config can work cross platform - extension will be re-added if necessary later
set runtime [string range $runtime 0 end-4]
}
#Target platform is declared per kit-config entry (4th element) but is a
#property of the RUNTIME: one binary lives in one store tier and has one
#executable convention. Entries on a line may therefore repeat the
#declaration but must not disagree.
set line_target ""
foreach vfsconfig $vfs_specs {
if {[llength $vfsconfig] < 4} {
continue
}
set declared [lindex $vfsconfig 3]
if {$declared eq ""} {
continue
}
if {$line_target eq ""} {
set problem [platform_name_problem $declared]
if {$problem ne ""} {
lappend configerrors "CONFIG FILE ERROR. runtime: $runtime declares target platform '$declared' - $problem."
continue
}
set line_target $declared
} elseif {$declared ne $line_target} {
lappend configerrors "CONFIG FILE ERROR. runtime: $runtime declares conflicting target platforms ('$line_target' and '$declared') in $mapfile - a runtime has one target."
}
}
if {$line_target eq ""} {
set line_target $default_target
}
set rtdir [file join $rtbase [platform_store_tier $line_target]]
set exe_suffix [platform_exe_suffix $line_target]
if {$runtime ne "-"} {
set runtime_test $runtime$exe_suffix
if {![file exists [file join $rtdir $runtime_test]]} {
lappend warnings "WARNING: Missing runtime file $rtdir/$runtime_test (line in mapvfs.config: $ln)"
lappend missing $runtime
}
}
foreach vfsconfig $vfs_specs {
switch -- [llength $vfsconfig] {
1 - 2 - 3 - 4 - 5 {
#5th element (G-133): smoke-require package list for the built kit -
#interim line format; the schema's eventual home is the G-024 toml conversion
lassign $vfsconfig vfstail appname target_kit_type - smokerequires
if {![file isdirectory [file join $sourcefolder vfs $vfstail]]} {
lappend warnings "WARNING: Missing vfs folder [file join $sourcefolder vfs $vfstail] specified in mapvfs.config for runtime $runtime"
lappend missing $vfstail
} else {
if {$appname eq ""} {
set appname [file rootname $vfstail]
}
dict lappend vfs_runtime_map $vfstail [list $runtime $appname $target_kit_type $line_target $smokerequires]
}
}
default {
set badline "bad entry in mapvfs.config - expected each entry after the runtime name to be a list of 1 to 5 elements {vfsfolder ?kitname? ?kittype? ?targetplatform? ?smokerequires?}. got: $vfsconfig ([llength $vfsconfig])"
lappend warnings $badline
lappend badentries $badline
}
}
}
if {[dict exists $runtime_vfs_map $runtime]} {
lappend configerrors "CONFIG FILE ERROR. runtime: $runtime was specified more than once in $mapfile."
} else {
dict set runtime_vfs_map $runtime $vfs_specs
dict set runtime_target $runtime $line_target
}
}
dict set model runtime_vfs_map $runtime_vfs_map
dict set model vfs_runtime_map $vfs_runtime_map
dict set model runtime_target $runtime_target
dict set model missing $missing
dict set model warnings $warnings
dict set model badentries $badentries
dict set model configerrors $configerrors
return $model
}
# Ordered kit-output enumeration over a mapvfs_parse model.
# Replicates the kit loop's iteration + naming (vfs_tails glob order with map
# extras appended, per-vfs runtime order from the mapping, appname defaulting to
# the vfs rootname, kit_type defaulting to 'kit', '-' runtime -> <appname>.kit,
# TARGET .exe suffix, duplicate appname -> <appname>_<runtime>) so listed names
# match what a bake produces. Entries whose vfs folder is missing on disk never
# reach the kit loop - they are appended after the buildable set so 'bakelist'
# can surface them as broken config. Duplicate-name disambiguation assumes the
# config keeps appnames unique (as the kit loop itself effectively does).
# $rtbase is the store ROOT (bin/runtime): each record resolves its own tier
# under it, so entries targeting different platforms report their own store
# presence (G-122). Returns a list of record dicts:
# kitname base output name (selection key, e.g punk91)
# targetkit platform artifact name (e.g punk91.exe, or <name>.kit for '-')
# kit_type kit|zip|zipcat|cookfs... as configured (defaulted to kit)
# runtime runtime name as configured (unsuffixed), or "-"
# runtime_file target runtime filename ("" for "-")
# runtime_present 1|0 (1 for "-": no runtime needed)
# runtime_dir store tier folder holding the runtime ("" for "-")
# target target platform (e.g win32-x86_64)
# store_tier bin/runtime tier folder name for the target
# vfs vfs folder tail (e.g punk9wintk903.vfs)
# vfs_present 1|0
# smokerequire G-133 smoke-require package list as configured ("" when undeclared)
proc ::punkboot::lib::mapvfs_kit_outputs {model rtbase sourcefolder} {
set runtime_vfs_map [dict get $model runtime_vfs_map]
set vfs_runtime_map [dict get $model vfs_runtime_map]
set runtime_target [dict get $model runtime_target]
set default_target [dict get $model default_target]
set vfs_tails [glob -nocomplain -dir $sourcefolder/vfs -types d -tail *.vfs]
dict for {vfstail -} $vfs_runtime_map {
if {$vfstail ni $vfs_tails} {
lappend vfs_tails $vfstail
}
}
set records [list]
set exe_names_seen [list]
set record_pair {{rtname vfstail appname target_kit_type smokerequires} {
upvar 1 records records exe_names_seen exe_names_seen rtbase rtbase sourcefolder sourcefolder\
runtime_target runtime_target default_target default_target
if {$appname eq ""} {
set appname [file rootname $vfstail]
}
if {$target_kit_type eq ""} {
set target_kit_type "kit"
}
if {[dict exists $runtime_target $rtname]} {
set target [dict get $runtime_target $rtname]
} else {
set target $default_target
}
set store_tier [::punkboot::lib::platform_store_tier $target]
if {$rtname eq "-"} {
set targetkit $appname.kit
set kitname $appname
set runtime_file ""
set runtime_dir ""
set runtime_present 1 ;#no runtime needed
} else {
set runtime_dir [file join $rtbase $store_tier]
set runtime_file $rtname[::punkboot::lib::platform_exe_suffix $target]
set targetkit ${appname}[::punkboot::lib::platform_exe_suffix $target]
set kitname $appname
if {$targetkit in $exe_names_seen} {
#duplicate appname configured - kit loop disambiguates the same way
set targetkit ${appname}_$rtname
set kitname ${appname}_$rtname
}
set runtime_present [file exists [file join $runtime_dir $runtime_file]]
}
lappend exe_names_seen $targetkit
lappend records [dict create\
kitname $kitname\
targetkit $targetkit\
kit_type $target_kit_type\
runtime $rtname\
runtime_file $runtime_file\
runtime_present $runtime_present\
runtime_dir $runtime_dir\
target $target\
store_tier $store_tier\
vfs $vfstail\
vfs_present [file isdirectory [file join $sourcefolder vfs $vfstail]]\
smokerequire $smokerequires\
]
}}
foreach vfstail $vfs_tails {
if {![dict exists $vfs_runtime_map $vfstail]} {
continue ;#unmapped vfs folder - the kit loop derives no output names from it
}
foreach rt_app [dict get $vfs_runtime_map $vfstail] {
set rtname [lindex $rt_app 0]
if {![dict exists $runtime_vfs_map $rtname]} {
continue
}
foreach vfs_app [dict get $runtime_vfs_map $rtname] {
lassign $vfs_app configured_vfs appname target_kit_type - smokerequires
if {$configured_vfs ne $vfstail} {
continue
}
apply $record_pair $rtname $vfstail $appname $target_kit_type $smokerequires
}
}
}
#entries whose vfs folder is missing (excluded from vfs_runtime_map by the parse)
dict for {rtname vfs_specs} $runtime_vfs_map {
foreach vfsconfig $vfs_specs {
if {[llength $vfsconfig] < 1 || [llength $vfsconfig] > 5} {
continue
}
lassign $vfsconfig vfstail appname target_kit_type - smokerequires
if {[dict exists $vfs_runtime_map $vfstail]} {
continue ;#already enumerated above
}
apply $record_pair $rtname $vfstail $appname $target_kit_type $smokerequires
}
}
return $records
}
# Match user-supplied kit names against mapvfs_kit_outputs records.
# Accepts the base kit name (punk91) or the platform artifact name (punk91.exe,
# name.kit); matching is case-insensitive when the HOST filesystem is (a name
# the user types is a host-side convenience - a cygwin-family host is as
# case-insensitive as a native windows one, whatever it targets). Returns a dict:
# selected matched records (kit-output order, deduplicated)
# unknown supplied names that matched nothing
proc ::punkboot::lib::mapvfs_match_outputs {kit_outputs names} {
set on_windows [expr {[info exists ::punkboot::host_windows] ? $::punkboot::host_windows : ("windows" eq $::tcl_platform(platform))}]
set selected_idx [list]
set unknown [list]
foreach name $names {
set base $name
if {[string match -nocase *.exe $base] || [string match -nocase *.kit $base]} {
set base [string range $base 0 end-4]
}
set found 0
set i 0
foreach rec $kit_outputs {
foreach candidate [list [dict get $rec kitname] [dict get $rec targetkit]] {
if {$candidate eq ""} {continue}
if {($on_windows && [string equal -nocase $candidate $base]) || (!$on_windows && $candidate eq $base)\
|| ($on_windows && [string equal -nocase $candidate $name]) || (!$on_windows && $candidate eq $name)} {
set found 1
break
}
}
if {$found} {
if {$i ni $selected_idx} {
lappend selected_idx $i
}
break
}
incr i
}
if {!$found} {
lappend unknown $name
}
}
set selected [list]
foreach i [lsort -integer $selected_idx] {
lappend selected [lindex $kit_outputs $i]
}
return [dict create selected $selected unknown $unknown]
}
# Local runtime-materialization staleness core (shared by the bake-path
# BUILD-WARNING and the bakelist report - the G-121 reuse of the G-103/G-117
# toml-revision metadata). Compares a punk-runtime WORKING COPY's beside-toml
# revision against the highest -r<N> artifact revision present in the same
# folder. Returns an empty dict when there is nothing to report (pre-family
# runtime without a toml, direct -r<N> artifact reference, or no newer artifact
# beside the working copy); otherwise a dict {current_rev N maxrev N maxname S}.
proc ::punkboot::lib::runtime_materialization_check {rtfolder runtime_fullname} {
set root $runtime_fullname
if {[string match -nocase *.exe $root]} {
set root [file rootname $root]
}
if {[regexp -- {-r\d+$} $root]} {
return [dict create] ;#an immutable artifact referenced directly - not a working copy
}
set toml [file join $rtfolder ${root}.toml]
if {![file isfile $toml]} {
return [dict create]
}
if {[catch {
set f [open $toml r]
set tomldata [read $f]
close $f
}]} {
return [dict create]
}
if {![regexp -line {^\s*revision\s*=\s*(\d+)} $tomldata -> current_rev]} {
return [dict create]
}
set maxrev -1
set maxname ""
foreach cand [glob -nocomplain -directory $rtfolder -tails -- "${root}-r*"] {
if {[regexp -- {^.+-r(\d+)(?:\.[Ee][Xx][Ee])?$} $cand -> rev]} {
if {$rev > $maxrev} {
set maxrev $rev
set maxname $cand
}
}
}
if {$maxrev > $current_rev} {
return [dict create current_rev $current_rev maxrev $maxrev maxname $maxname]
}
return [dict create]
}
# Byte-equality of two files (chunked compare, early exit on first difference).
# Used by kit_deploy_state - avoids hashing dependencies in the boot path.
proc ::punkboot::lib::files_content_identical {patha pathb} {
if {[file size $patha] != [file size $pathb]} {
return 0
}
set fa [open $patha r]
set fb [open $pathb r]
set same 1
try {
chan configure $fa -translation binary -buffersize 262144
chan configure $fb -translation binary -buffersize 262144
while {1} {
set da [read $fa 262144]
set db [read $fb 262144]
if {$da ne $db} {
set same 0
break
}
if {[chan eof $fa] || [chan eof $fb]} {
if {[chan eof $fa] != [chan eof $fb]} {
set same 0
}
break
}
}
} finally {
close $fa
close $fb
}
return $same
}
# Deployed-state classification for a configured kit output (G-121 bakelist):
# the deployed copy (<projectdir>/bin/<targetkit>) vs the build product
# (src/_build/<targetkit>).
# absent - no deployed copy in the bin folder
# nobuild - deployed copy exists but there is no build product to compare against
# current - deployed copy is byte-identical to the build product
# stale - deployed copy differs from the build product
# Size mismatch decides 'stale' cheaply; equal size + equal mtime short-circuits
# to 'current' (the deploy step is a plain 'file copy'); otherwise a full content
# compare decides.
proc ::punkboot::lib::kit_deploy_state {buildfolder deployfolder targetkit} {
set built [file join $buildfolder $targetkit]
set deployed [file join $deployfolder $targetkit]
if {![file isfile $deployed]} {
return absent
}
if {![file isfile $built]} {
return nobuild
}
if {[file size $built] != [file size $deployed]} {
return stale
}
if {[file mtime $built] == [file mtime $deployed]} {
return current
}
if {[punkboot::lib::files_content_identical $built $deployed]} {
return current
}
return stale
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
if {"::try" ni [info commands ::try]} {
puts stderr "Tcl interpreter possibly too old - need at least tcl 8.6 - 'try' command not found - aborting"
exit 1
}
#------------------------------------------------------------------------------
#Module loading from src/bootsupport or [pwd]/modules if pwd is a 'src' folder
#------------------------------------------------------------------------------
#If there is a folder under the current directory, in the subpath src/bootsupport/modules which contains .tm files
# - then it will attempt to preference these modules
# This allows a source update via 'fossil update' 'git pull' etc to pull in a minimal set of support modules for the boot script
# and load these in preference to ones that may have been in the interp's tcl::tm::list or auto_path due to environment variables
set startdir [pwd]
#puts "SCRIPTFOLDER: $::punkboot::scriptfolder"
#we are focussed on pure-tcl libs/modules in bootsupport for now.
#There may be cases where we want to use compiled packages from src/bootsupport/modules_tcl9 etc
#REVIEW - punkboot can really speed up with appropriate accelerators and/or external binaries
# - we need to support that without binary downloads from repos unless the user explicitly asks for that.
# - They may already be available in the vfs (or pointed to package paths) of the running executable.
# - todo: some user prompting regarding installs with platform-appropriate package managers
# - todo: some user prompting regarding building accelerators from source.
# -------------------------------------------------------------------------------------
set bootsupport_module_paths [list]
set bootsupport_library_paths [list]
set this_platform_generic [punkboot::lib::platform_punk] ;#normalized punkshell platform-dir name (punk::platform canon)
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#G-122 host/target split. $this_platform_generic is the HOST canon and stays the
#key for everything that describes THIS interpreter (bootsupport/vendorlib
#platform dirs below, diagnostics). What the build EMITS is keyed by target:
# host_platform - canon of the driving tclsh (same value, named for clarity)
# target_platform - default target for kit outputs; a cygwin-family host
# (msys2/cygwin runtime on windows) builds win32 kits.
# Per-entry mapvfs.config declarations override it per runtime.
# host_windows - host process/filesystem semantics are windows-like
# (native windows OR cygwin family): drives copy commands,
# path case comparison, prompt behaviour - NOT artifact naming.
set ::punkboot::host_platform $this_platform_generic
set ::punkboot::target_platform [punkboot::lib::platform_target_default $this_platform_generic]
set ::punkboot::host_windows [expr {[punkboot::lib::platform_process_family $this_platform_generic] eq "windows"}]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#we always create these lists in order of desired precedence.
# - this is the same order when adding to auto_path - but will need to be reversed when using tcl:tm::add
if {[file exists [file join $::punkboot::scriptfolder bootsupport]]} {
set bootsupportdir [file join $::punkboot::scriptfolder bootsupport]
puts stderr "Using bootsupport dir $bootsupportdir"
lappend bootsupport_module_paths [file join $bootsupportdir modules_tcl$::tclmajorv] ;#more version-specific modules slightly higher in precedence order
lappend bootsupport_module_paths [file join $bootsupportdir modules]
lappend bootsupport_library_paths [file join $bootsupportdir lib_tcl$::tclmajorv/allplatforms] ;#more version-specific pkgs slightly higher in precedence order
lappend bootsupport_library_paths [file join $bootsupportdir lib_tcl$::tclmajorv/$this_platform_generic] ;#more version-specific pkgs slightly higher in precedence order
lappend bootsupport_library_paths [file join $bootsupportdir lib]
} else {
puts stderr "No bootsupport dir for script [info script] at [file join $::punkboot::scriptfolder bootsupport]"
#G-122 host-personality diagnosis: a cygwin-family tclsh (msys2/cygwin runtime on
#windows) is a POSIX Tcl - 'C:/path/make.tcl' is not an absolute path to it, so
#'file normalize' silently prefixes the cwd and every derived path is wrong. The
#failure that follows (missing bootsupport, then an unresolvable project root) is
#unrecognisable without this note. Caller-side spelling, not something make.tcl can
#safely rewrite - name the script in the host's own path syntax.
if {[punkboot::lib::platform_is_cygwin_family $this_platform_generic] && [regexp {^([A-Za-z]):[/\\](.*)$} [info script] -> _cygdrive _cygrest]} {
puts stderr " NOTE: this tclsh is a $this_platform_generic (msys2/cygwin-runtime) build - a POSIX Tcl, to which the windows-style path '[info script]' is NOT absolute, so it was resolved relative to the current directory."
puts stderr " Re-run naming the script in this shell's own path syntax: /[string tolower $_cygdrive]/[string map {\\ /} $_cygrest]"
unset -nocomplain _cygdrive _cygrest
}
#lappend bootsupport_module_paths [file join $startdir bootsupport modules_tcl$::tclmajorv]
#lappend bootsupport_module_paths [file join $startdir bootsupport modules]
#lappend bootsupport_library_paths [file join $startdir bootsupport lib_tcl$::tclmajorv/allplatforms]
#lappend bootsupport_library_paths [file join $startdir bootsupport lib_tcl$::tclmajorv/$this_platform_generic]
#lappend bootsupport_library_paths [file join $startdir bootsupport lib]
}
set bootsupport_paths_exist 0
foreach p [list {*}$bootsupport_module_paths {*}$bootsupport_library_paths] {
if {[file exists $p]} {
set bootsupport_paths_exist 1 ;#at least one exists
break
}
}
# -------------------------------------------------------------------------------------
# -------------------------------------------------------------------------------------
set sourcesupport_module_paths [list]
set sourcesupport_library_paths [list]
set sourcesupport_paths_exist 0
#we deliberately don't use [pwd]/modules because commonly the launch dir may be the project dir.
#The <projectdir>/modules are the very modules we are building - and may be in a broken state, which punkboot then can't fix.
#The 'building' is generally just assigning a version instead of 999999.0a1 (and some doc string substitution?)
#(most?) Modules in src/modules etc should still be runnable directly in certain cases like this where we point to them.
if {[file tail $startdir] eq "src"} {
#todo - other src 'module' dirs..
foreach p [list $startdir/modules_tcl$::tclmajorv $startdir/modules $startdir/vendormodules_tcl$::tclmajorv $startdir/vendormodules] {
if {[file exists $p]} {
lappend sourcesupport_module_paths $p
}
}
# -- -- --
foreach p [list $startdir/lib_tcl$::tclmajorv/allplatforms $startdir/lib_tcl$::tclmajorv/$this_platform_generic $startdir/lib $startdir/vendorlib_tcl$::tclmajorv/allplatforms $startdir/vendorlib_tcl$::tclmajorv/$this_platform_generic $startdir/vendorlib] {
if {[file exists $p]} {
lappend sourcesupport_library_paths $p
}
}
# -- -- --
foreach p [list {*}$sourcesupport_module_paths {*}$sourcesupport_library_paths] {
if {[file exists $p]} {
set sourcesupport_paths_exist 1
break
}
}
if {$sourcesupport_paths_exist} {
#launch from <projectdir/src is also likely to be common
# but we need to be loud about what's going on.
puts stderr "------------------------------------------------------------------"
puts stderr "Launched from within a folder ending in 'src'"
puts stderr " - modules in $startdir/modules $startdir/lib (etc) may override bootsupport modules"
puts stderr "------------------------------------------------------------------"
}
}
# -------------------------------------------------------------------------------------
set original_tm_list [tcl::tm::list]
set original_auto_path $::auto_path
set package_paths_modified 0
if {$bootsupport_paths_exist || $sourcesupport_paths_exist} {
tcl::tm::remove {*}$original_tm_list
#very basic test there is something there..
set support_contents_exist 0
foreach p [list {*}$bootsupport_module_paths {*}$bootsupport_library_paths {*}$sourcesupport_module_paths {*}$sourcesupport_library_paths] {
#set contents [glob -nocomplain -dir $p -tail *]
if {![file exists $p]} {continue}
set contents [punkboot::lib::folder_nondotted_children $p]
set readmeposn [lsearch -nocase $contents readme.md]
#don't assume 'ledit' available
set contents [lreplace $contents[set contents {}] $readmeposn $readmeposn] ;#list unchanged if -1
if {[llength $contents]} {
set support_contents_exist 1
break
}
}
set tcl_core_packages [list tcl::zlib zlib tcl::oo TclOO tcl::tommath tcl::zipfs Tcl Tk]
if {$support_contents_exist} {
#only forget all *unloaded* package names
foreach pkg [package names] {
if {$pkg in $tcl_core_packages} {
continue
}
if {![llength [package versions $pkg]]} {
#puts stderr "Got no versions for pkg $pkg"
continue
}
if {![string length [package provide $pkg]]} {
#no returned version indicates it wasn't loaded - so we can forget its index
package forget $pkg
}
}
#Deliberately omit original_tm_list and original_auto_path
tcl::tm::add {*}[lreverse $bootsupport_module_paths] {*}[lreverse $sourcesupport_module_paths] ;#tm::add works like LIFO. sourcesupport_module_paths end up earliest in resulting tm list.
set ::auto_path [list {*}$sourcesupport_library_paths {*}$bootsupport_library_paths]
}
#puts "----> auto_path $::auto_path"
#puts "----> tcl::tm::list [tcl::tm::list]"
#maint: also in punk::repl package
#--------------------------------------------------------
set libunks [list]
foreach tm_path [tcl::tm::list] {
set punkdir [file join $tm_path punk]
if {![file exists $punkdir]} {continue}
lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm]
}
set libunknown ""
set libunknown_version_sofar ""
foreach lib $libunks {
#expecting to be of form libunknown-<tclversion>.tm
set vtail [lindex [split [file tail $lib] -] 1]
set thisver [file rootname $vtail] ;#file rootname x.y.z.tm
if {$libunknown_version_sofar eq ""} {
set libunknown_version_sofar $thisver
set libunknown $lib
} else {
if {[package vcompare $thisver $libunknown_version_sofar] == 1} {
set libunknown_version_sofar $thisver
set libunknown $lib
}
}
}
if {$libunknown ne ""} {
if {[info commands ::punk::libunknown::package] ne ""} {
#libunknown already active in this interp - e.g make.tcl driven by a built punk
#executable whose boot (punk_main.tcl) initialised it. init's rename of ::package
#must not be repeated (its guard would emit an 'init already done' diagnostic and
#return), and re-sourcing would silently swap the running copy for the bootsupport
#copy - leave the active one in place.
} else {
source $libunknown
if {[catch {punk::libunknown::init -caller make.tcl} errM]} {
puts stderr "error initialising punk::libunknown\n$errM"
}
}
#puts stdout " *** [package names]"
#puts stdout " **** [dict get $::punk::libunknown::epoch pkg untracked]"
} else {
puts stderr "Failed to find punk::libunknown"
}
#--------------------------------------------------------
#package require Thread
#puts "---->tcl_library [info library]"
#puts "---->loaded [info loaded]"
# - the full repl requires Threading and punk,shellfilter,shellrun to call and display properly.
# tm list already indexed - need 'package forget' to find modules based on current tcl::tm::list
#These are strong dependencies
#package forget punk::mix
#package forget punk::repo
#package forget punkcheck
#------------------------------------------------------------------
# Bootsupport staleness check
# When make.tcl is run from project root (not from src/), bootsupport
# modules are loaded in preference to source modules. If the source
# modules have been updated (e.g API changes) but bootsupport hasn't
# been rebuilt, make.tcl will fail with obscure errors from the stale
# bootsupport versions. This check compares buildversion.txt in source
# against the highest .tm version in bootsupport and warns the caller.
#------------------------------------------------------------------
if {[file tail $startdir] ne "src"} {
set _runtime_deps [list {*}{
} punkcheck punkcheck-buildversion.txt punkcheck-*.tm {*}{
} punk::repo punk/repo-buildversion.txt punk/repo-*.tm {*}{
} punk::mix punk/mix-buildversion.txt punk/mix-*.tm {*}{
} punk::tdl punk/tdl-buildversion.txt punk/tdl-*.tm {*}{
} punk::args punk/args-buildversion.txt punk/args-*.tm {*}{
}]
set _stale_modules [list]
foreach {pkg buildversion_rel bootsupport_glob} $_runtime_deps {
set _src_bv_file [file join $::punkboot::scriptfolder modules $buildversion_rel]
set _bs_glob_dir [file dirname [file join $::punkboot::scriptfolder bootsupport modules $bootsupport_glob]]
set _bs_glob_pat [file tail $bootsupport_glob]
if {![file exists $_src_bv_file]} {continue}
#read source version (first line of buildversion.txt)
set _fd [open $_src_bv_file r]
set _src_version [string trim [lindex [split [read $_fd] \n] 0]]
close $_fd
#find highest version .tm in bootsupport
set _bs_version ""
set _prefix [string range $_bs_glob_pat 0 [string first "*" $_bs_glob_pat]-1]
foreach _tm [glob -nocomplain -dir $_bs_glob_dir -- $_bs_glob_pat] {
set _v [file rootname [string range [file tail $_tm] [string length $_prefix] end]]
if {$_bs_version eq "" || [package vcompare $_v $_bs_version] == 1} {
set _bs_version $_v
}
}
if {$_bs_version ne "" && $_src_version ne "" && [package vcompare $_src_version $_bs_version] == 1} {
set _bump [::punkboot::lib::bootsupport_bump_level $_bs_version $_src_version]
lappend _stale_modules [list $pkg $_src_version $_bs_version $_bump]
}
}
if {[llength $_stale_modules]} {
set ::punkboot::stale_bootsupport $_stale_modules
}
unset _runtime_deps _stale_modules
}
package require punk::repo ;#todo - push our requirements to a smaller punk::repo::xxx package with minimal dependencies
package require punk::mix
package require punkcheck
package require punk::lib
#G-030 degrade rule: punk::args (declarative dispatch/help) and its tabled-rendering stack
#(punk::ansi, textblock) are guarded - a stale/missing snapshot of these must never brick
#the make.tcl commands used to repair it (check, bootsupport, modules). Dispatch and help
#fall back to the self-contained scan / plain-text help further below when absent.
foreach _optpkg {punk::args punk::ansi textblock} {
if {[catch {package require $_optpkg} _opterr]} {
puts stderr "make.tcl: boot package $_optpkg unavailable from bootsupport ($_opterr) - continuing degraded (plain help/argument handling)"
}
}
unset -nocomplain _optpkg _opterr
set package_paths_modified 1
#------------------------------------------------------------------------------
#puts "----> llength package names [llength [package names]]"
}
set ::punkboot::pkg_requirements_found [list]
#we will treat 'package require <mver>.<etc>' (minbounded) as <mver>.<etc>-<mver+1> ie explicitly convert to corresponding bounded form
#put some with leading zeros to test normalisation
set ::punkboot::bootsupport_requirements [dict create {*}{
} punk::repo [list version {00.01.01-}] {*}{
} punk::mix [list version {}] {*}{
} punk::ansi [list] {*}{
} punk::args [list] {*}{
} overtype [list version {1.6.5-}] {*}{
} punkcheck [list] {*}{
} fauxlink [list version {0.1.1-}] {*}{
} textblock [list version 0.1.1-] {*}{
} fileutil [list] {*}{
} fileutil::traverse [list] {*}{
} struct::list [list] {*}{
} md5 [list version 2-] {*}{
}
]
#while we are converting plain version numbers to explicit bounded form - we'll also do some validation of the entries
dict for {pkg pkginfo} $::punkboot::bootsupport_requirements {
if {[dict exists $pkginfo version]} {
set ver [string trim [dict get $pkginfo version]]
if {![catch {::punkboot::lib::tm_version_required_canonical $ver} canonical]} {
if {$canonical ne $ver} {
dict set pkginfo version $canonical ;# plain ver mapped to min-max. min- and min-max and empty left as is
dict set ::punkboot::bootsupport_requirements $pkg $pkginfo
}
} else {
puts stderr "punkboot::bootsupport_requirements - package $pkg has invalid version specification '$ver'"
exit 1
}
} else {
#make sure each has a blank version entry if nothing was there.
dict set pkginfo version ""
dict set ::punkboot::bootsupport_requirements $pkg $pkginfo
}
}
#Assert - our bootsupport_requirement version numbers should now be either empty or of the form min- or min-max
#dict for {k v} $::punkboot::bootsupport_requirements {
# puts "- $k $v"
#}
#some of our toplevel package specified in bootsupport_requirements may trigger 'package require' for dependencies that we know are optional/not required.
#By listing them here we can produce better warnings
set ::punkboot::bootsupport_optional [dict create {*}{
} tcllibc [list -note {improves performance significantley}] {*}{
} twapi [list] {*}{
} patternpunk [list] {*}{
} cryptkit [list -note {accelerates some packages}] {*}{
} Trf [list -note {accelerates some packages}] {*}{
}]
set ::punkboot::bootsupport_recommended [dict create {*}{
} tcllibc [list -note {improves performance significantley}]
]
# ** *** *** *** *** *** *** *** *** *** *** ***
# create an interp in which we hijack package command
# This allows us to auto-gather some dependencies (not necessarily all and not necessarily strictly required)
# Note: even in a separate interp we could still possibly get side-effects if a package has compiled components - REVIEW
# Hopefully the only side-effect is that a subsequent load of the package will be faster...
# (punk boot is intended to operate without compiled components - but some could be pulled in by tcl modules if they're found)
# (tcllibc is also highly desirable as the performance impact when not available can be dramatic.)
# ... but if the binary is loaded with a different path name when we come to actually use it - there could be issues.
# A truly safe way to do this might be to call out to a separate process, or to relaunch after checks. (todo?)
# A truly accurate way to do this is to have dependencies properly recorded for every package -
# something the package developer would have to provide - or an analyst would have to determine by looking at the code.
# (to check for 'package require' statements that are actually optional, one-or-more-of-n, mutually-exclusive, anti-requirements etc)
# Such information may also vary depending on what features of the package are to be used here - so it's a tricky problem.
#
# Nevertheless - the auto-determination can be a useful warning to the punk boot developer that something may be missing in the bootsupport.
#
# A further auto-determination for optionality could potentially be done in yet another interp by causing package require to fake-error on a dependency -
# and see if the parent still loads. This would still be more time and complexity for a still uncertain result.
# e.g a package may be a strong requirement for the package being examined iff another optional package is present (which doesn't itself require that dependency)
# - it's unclear that reasonable determinations always can be made.
# There are also packages that aren't required during one package's load - but are required during certain operations.
# ** *** *** *** *** *** *** *** *** *** *** ***
proc ::punkboot::check_package_availability {args} {
#best effort at auto-determinining packages required (dependencies) based on top-level packages in the list.
#Without fully parsing the package-loading Tcl scripts and examining all side-effects (an unlikely capability),
# this is not going to be as accurate as the package developer providing a definitive list of which packages are required and which are optional.
# 'optionality' is a contextual concept anyway depending on how the package is intended to be used.
# The package developer may consider a feature optional - but it may not be optional in a particular usecase.
set bootsupport_requirements [lindex $args end]
set usage "punkboot::check_package_availability ?-quiet 0|1? package_list"
if {![llength $bootsupport_requirements]} {
error "usage: $usage"
}
set opts [lrange $args 0 end-1]
if {[llength $opts] % 2 != 0} {
error "incorrect number of arguments. usage: $usage"
}
set defaults [dict create {*}{
-quiet 1
}]
set opts [dict merge $defaults $opts]
set opt_quiet [dict get $opts -quiet]
interp create testpkgs
interp eval testpkgs [list package prefer [package prefer]]
interp eval testpkgs {
namespace eval ::test {}
set ::test::pkg_requested [list] ;#list of pairs (pkgname version_requested) version_requested is 'normalised' (min- /min-max only) or empty
set ::test::pkg_loaded [list]
set ::test::pkg_missing [list]
set ::test::pkg_broken [list]
set ::test::pkg_info [dict create]
tcl::tm::remove {*}[tcl::tm::list]
set ::auto_path [list]
}
#sync interp package paths with current state of package/library paths
interp eval testpkgs [list ::tcl::tm::add {*}[tcl::tm::list]]
interp eval testpkgs [list set ::auto_path $::auto_path]
interp eval testpkgs [list set ::test::bootsupport_requirements $bootsupport_requirements]
interp eval testpkgs [list set ::argv0 $::argv0]
interp eval testpkgs [list set ::opt_quiet $opt_quiet]
interp eval testpkgs {
#try {
rename ::package ::package_orig
variable ns_scanned [list]
#
proc ::tm_version_major {version} {
#if {![tm_version_isvalid $version]} {
# error "Invalid version '$version' is not a proper Tcl module version number"
#}
set firstpart [lindex [split $version .] 0]
#check for a/b in first segment
if {[string is integer -strict $firstpart]} {
return $firstpart
}
if {[string first a $firstpart] > 0} {
return [lindex [split $firstpart a] 0]
}
if {[string first b $firstpart] > 0} {
return [lindex [split $firstpart b] 0]
}
error "tm_version_major unable to determine major version from version number '$version'"
}
proc ::package {args} {
variable ns_scanned
if {[lindex $args 0] eq "require"} {
#review - difference between errors due to bad requirements format vs package missing/failed
#we should probably still put syntax errors into the datastructure to be ultimately shown to the user
if {[lindex $args 1] eq "-exact"} {
set pkgname [lindex $args 2]
set raw_requirements_list [lrange $args 3 end]
#review - what to do with invalid extra args? Normally it would raise an error
set version_requested [lindex $raw_requirements_list 0] ;#for now treat as exactly one requirement when -exact
#normalise!
set version_requested "$version_requested-$version_requested"
lappend requirements_list $version_requested
} else {
set pkgname [lindex $args 1]
#usually only a single requirement - but we must handle multiple
set raw_requirements_list [lrange $args 2 end] ;#may be also be pattern like ver- (min-unbounded) or ver1-ver2 (bounded) (which will match >=ver1 but strictly < ver2) (or like -exact if ver1=ver2)
set requirements_list [list]
foreach requirement $raw_requirements_list {
#set requirement [::punkboot::lib::tm_version_required_canonical $requirement]
#todo - work out how to get normalisation code in interp
if {[string trim $requirement] ne ""} {
if {[string first - $requirement] < 0} {
#plain ver - normalise to ver-nextmajor
#todo - we should fully normalise as we do in main script! (e.g leading zeroes - even though these should be rare)
set m [::tm_version_major $requirement]
set nextm [expr {$m +1}]
lappend requirements_list $requirement-$nextm
} else {
#has dash - we should normalize so keys match even if leading zeros!
lappend requirements_list $requirement
}
} else {
#empty or whitespace spec not allowed - should be syntax error
#add it to list anyway so that the underlying package call later can fail it appropriately
lappend requirements_list $requirement
}
}
#assert - added an entry for every raw requirement - even if doesn't appear to be valid
#$requirements_list may be empty = any version satisfies.
}
#should still distinguish: {pkgname {}} -valid vs {pkgname {{}}} due to empty string supplied in call - invalid - but leave for underlying package command to error on
set pkgrequest [list $pkgname $requirements_list]
if {$pkgrequest ni $::test::pkg_requested} {
lappend ::test::pkg_requested $pkgrequest
}
# -- -- --- --- --- --- --- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# Must ensure a scan has been done in the relevant subpath before attempting to gether package vervsion
set nsquals [namespace qualifiers $pkgname]
if {$nsquals ne "" && $nsquals ni $ns_scanned} {
catch {::package_orig require ${nsquals}::zzz-nonexistant} ;#scan every ns encountered once - or we will get no result from 'package versions' for sub namespaces.
lappend ns_scanned $nsquals
}
set versions [::package_orig versions $pkgname]
#An empty result from versions doesn't always indicate we can't load the package!
#REVIEW - known to happen with 'package versions Tcl' - what other circumstances?
# -- -- --- --- --- --- --- -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#fill in a blank pinfo dict to get some consistent ordering
if {[dict exists $::test::pkg_info $pkgrequest]} {
set pinfo [dict get $::test::pkg_info $pkgrequest]
} else {
set pinfo [dict create version "" versions $versions version_requested $requirements_list required_by [list]]
}
if {[llength $::test::pkg_stack]} {
set caller [lindex $::test::pkg_stack end]
set required_by [dict get $pinfo required_by]
if {$caller ni $required_by} {
lappend required_by $caller
}
dict set pinfo required_by $required_by
}
lappend ::test::pkg_stack $pkgname
#At this point we could short circuit if we've already classified this package/requirements combo as missing/broken from a previous require
#review - there is some chance the exact pkg/requirements combo may succeed after an earlier failure if some package adjusted search paths..
#however - the pkg should maintain a failure record - treating it as successful is likely to hide relevant info
if {$pkgrequest in [list {*}$::test::pkg_missing {*}$::test::pkg_broken]} {
set ::test::pkg_stack [lrange $::test::pkg_stack 0 end-1]
dict set ::test::pkg_info $pkgrequest $pinfo
return
}
#use our normalised requirements instead of original args
#if {[catch [list ::package_orig {*}$args] result]} {}
if {[catch [list ::package_orig require $pkgname {*}$requirements_list] result]} {
dict set pinfo testerror $result
#package missing - or exists - but failing to initialise
if {!$::opt_quiet} {
set parent_path [lrange $::test::pkg_stack 0 end-1]
puts stderr "[punkboot::sgr 32] $pkgname versions: $versions error: $result[punkboot::sgr]"
set parent_path [join $parent_path " -> "]
puts stderr "pkg requirements: $parent_path"
puts stderr "error during : '$args'"
puts stderr " [punkboot::sgr 93]$result[punkboot::sgr]"
}
#the failed package may still exist - so we could check 'package files' and 'package ifneeded' here too - REVIEW
#to determine the version that we attempted to load,
#- we need to look at 'pkg versions' vs -exact / ver / ver-ver (using package vsatisfies)
if {![llength $versions]} {
#no versions *and* we had an error - missing is our best guess. review.
#'package versions Tcl' never shows any results
#so requests for old versions will show as missing not broken.
#This is probably better anyway.
if {$pkgrequest ni $::test::pkg_missing} {
lappend ::test::pkg_missing $pkgrequest
}
} else {
if {$pkgrequest ni $::test::pkg_broken} {
lappend ::test::pkg_broken $pkgrequest
}
#all we know about failed pkg is in the error $result
#we can't reliably determine which version of possibly many it was trying to load just based on error msgs.
#(we often could - but not always)
#Instead - use the properly ordered versions and knowledge of which pkg 'package require' would have picked.
#'package versions' does not always return ordered earliest to latest! (e.g 'package versions http' -> 2.10b1 2.9.8)
set ordered_versions [lsort -command {::package_orig vcompare} [::package_orig versions $pkgname]]
if {[::package_orig prefer] eq "stable"} {
#to support 'package prefer' = stable we have to strip alpha/beta versions
set selectable_versions [list]
foreach v $ordered_versions {
if {[string match *a* $v] || [string match *b* $v]} {
#presence of an a or b indicates 'unstable'
continue
}
lappend selectable_versions $v
}
} else {
#we are operating under 'package prefer' = latest
set selectable_versions $ordered_versions
}
if {[llength $requirements_list]} {
#add one or no entry for each requirement.
#pick highest at end
set satisfiers [list]
foreach requirement $requirements_list {
foreach ver [lreverse $selectable_versions] {
if {[package vsatisfies $ver $requirement]} {
lappend satisfiers $ver
break
}
}
}
if {[llength $satisfiers]} {
set satisfiers [lsort -command {::package_orig vcompare} $satisfiers]
dict set pinfo version [lindex $satisfiers end]
}
} else {
#package require will have picked highest/latest
dict set pinfo version [lindex $selectable_versions end]
}
}
#Note that we must return without error in order to gather 'probable' dependencies.
#This is not completely accurate - as a lib/module may have wrapped a 'package require' in a catch
#In such a case the 'dependency' might be optional - but we currently have no way of determining this.
#By not returning an error - the loaded package may not behave correctly (e.g package state variables set differently?)
#- hence this is all done in a separate interp to be discarded.
#Note that pkgIndex.tcl scripts may commonly just 'return' and fail to do a 'package provide'
# - presumably the standard package require still raises an error in that case though - so it is different?
# - e.g at least some versions of struct::list did this. resulting in "can't find package struct::list" for tcl versions not supported.
# - even thoug it did find a package for struct::list.
set ::test::pkg_stack [lrange $::test::pkg_stack 0 end-1]
dict set ::test::pkg_info $pkgrequest $pinfo
return
} else {
#package loaded ok
lappend ::test::pkg_loaded $pkgrequest
set ifneeded_script [list uplevel 1 [list ::package_orig ifneeded $pkgname]] ;#not guaranteed to be a tcl list?
set pinfo [dict merge $pinfo [dict create version $result raw_ifneeded $ifneeded_script]]
set ::test::pkg_stack [lrange $::test::pkg_stack 0 end-1]
set relevant_files [list]
if {![catch {::package_orig files Tcl} ]} {
#tcl9 (also some 8.6/8.7) has 'package files' subcommand.
#unfortunately, in some cases (e.g md5 when no accelerators available) this can be a huge list (1000+) showing all scanned pkgIndex.tcl files from unrelated packages.
#We expect this to be fixed - but early Tcl9 (and some 8.6/8.7) versions may persist and have this behaviour
#see: https://core.tcl-lang.org/tcl/tktview/209fd9adce
set all_files [::package_orig files $pkgname]
#some arbitrary threshold? REVIEW
if {[llength $all_files] > 10} {
dict set pinfo warning "files_sourced_during_load=[llength $all_files]"
} else {
set relevant_files $all_files
dict set pinfo packagefiles $relevant_files
}
}
if {![llength $relevant_files]} {
dict set pinfo packagefiles {} ;#default
#there are all sorts of scripts, so this is not predictably structured
#e.g using things like apply
#we will attempt to get a trailing source .. <file>
set parts [split [string trim $ifneeded_script] {;}]
set trimparts [list]
foreach p $parts {
lappend trimparts [string trimright $p]
}
set last_with_text [lsearch -inline -not [lreverse $trimparts] ""] ;#could return empty if all blank
#we still don't assume any line is a valid tcl list..
if {$last_with_text ne "" && [regexp -- {\S+$} $last_with_text lastword]} {
#if it's a file or dir - close enough (?)
#e.g tcllibc uses apply and the last entry is actuall a folder used to find the file..
#we aren't brave enough to try to work out the actual file(s)
if {[file exists $lastword]} {
dict set pinfo packagefiles $lastword
}
}
}
dict set ::test::pkg_info $pkgrequest $pinfo
return $result
}
} else {
#puts stderr "package $args"
return [uplevel 1 [list ::package_orig {*}$args]]
}
}
set ::test::pkg_stack [list]
catch {::package_orig require zzz-non-existant} ;#scan so we get 'package versions' results
dict for {pkg pkgdict} $::test::bootsupport_requirements {
#set nsquals [namespace qualifiers $pkg]
#if {$nsquals ne ""} {
# catch {::package_orig require ${nsquals}::zzz-non-existant} ;#force scan of every level encountered
#}
set ::test::pkg_stack [list]
#run the instrumented 'package require' on the toplevel requirements
# dict key version always exists in pkgdict - version is empty or normalised to min- or min-max
set wanted [dict get $pkgdict version]
catch {package require $pkg {*}$wanted}
}
#} finally {
# #not strictly necessary as we'll tear down the interp
# catch {rename ::package ""}
# catch {rename ::package_orig ::package}
#}
# ** *** *** *** *** *** *** *** *** *** *** ***
#note we will have entries for each different way package was requested
set ::test::pkg_requested [lsort -unique $::test::pkg_requested]
#foreach pkg $::test::pkg_requested {
# set ver [package provide $pkg]
# if {$ver eq ""} {
# #puts stderr "missing pkg: $pkg"
# lappend ::test::pkg_missing $pkg
# } else {
# if {[string tolower $pkg] eq "tcl"} {
# #ignore
# #continue
# }
# lappend ::test::pkg_loaded $pkg
# }
#}
}
#extract results from testpkgs interp
set requested [interp eval testpkgs {set ::test::pkg_requested}]
set loaded [interp eval testpkgs {set ::test::pkg_loaded}]
set missing [interp eval testpkgs {set ::test::pkg_missing}]
set broken [interp eval testpkgs {set ::test::pkg_broken}]
set pkginfo [interp eval testpkgs {set ::test::pkg_info}]
interp delete testpkgs
#now run the normal package require on every pkg to see if our 'broken' assignments are correct?
#by returning without error in our fake package require - we have potentially miscategorised some in both the 'broken' and 'loaded' categories.
#a) - packages that are broken due to missing dependency but we haven't reported as such (the common case)
#b) - packages that we reported as broken because they tried to use a function from an optional dependency we didn't error on
#c) - other cases
#
#Note also by not erroring on a package require the package may have not attempted to load another package that would do the job.
#This is a case where we may completely fail to report a one-of-n dependency for example
# - hard to test without repeated runs :/
#todo - another interp?
#a 'normal' run now may at least mark/unmark some 'broken' packages and give at least some better feedback.
#we will test all discovered packages from the above process except those already marked as 'missing'
#both 'broken' and 'loaded' are still suspect at this point.
#we will attempt to load the -exact version that the previous test either appeared to load or fail in loading.
#Presumably that is the one that would be loaded in the normal course anyway - REVIEW.
#(as well as 'requestd' not guaranteed to be complete - but we will live with that for the purposes here)
interp create normaltest
interp eval normaltest [list package prefer [package prefer]]
interp eval normaltest {
set ::pkg_broken [list]
set ::pkg_loaded [list]
set ::pkg_errors [dict create]
tcl::tm::remove {*}[tcl::tm::list]
set ::auto_path [list]
}
set test_packages [list]
foreach pkgrequest $requested {
lassign $pkgrequest pkgname requirements_list
if {$pkgrequest ni $missing} {
if {[dict exists $pkginfo $pkgrequest version]} {
set tried_version [dict get $pkginfo $pkgrequest version]
} else {
set tried_version ""
}
lappend test_packages [list $pkgname $tried_version $requirements_list]
}
}
#sync interp package paths with current state of package/library paths
interp eval normaltest [list ::tcl::tm::add {*}[tcl::tm::list]]
interp eval normaltest [list set ::auto_path $::auto_path]
interp eval normaltest [list set ::test_packages $test_packages]
interp eval normaltest [list set ::argv0 $::argv0]
interp eval normaltest [list set ::opt_quiet $opt_quiet]
interp eval normaltest {
foreach testinfo $::test_packages {
lassign $testinfo pkgname ver requirements_list
#if {$ver eq ""} {
# set require_script [list package require $pkgname]
#} else {
# set require_script [list package require $pkgname $ver-$ver] ;#bounded same version - equivalent to -exact
#}
set require_script [list package require $pkgname {*}$requirements_list]
#puts "finaltest $pkgname requested:$requirements_list"
if {[catch $require_script result]} {
lappend ::pkg_broken [list $pkgname $requirements_list]
dict set ::pkg_errors [list $pkgname $requirements_list] $result
} else {
#result is version we actually got - without the previous interp's fudgery
if {![llength $requirements_list] || [package vsatisfies $result {*}$requirements_list]} {
lappend ::pkg_loaded [list $pkgname $requirements_list]
} else {
lappend ::pkg_broken [list $pkgname $requirements_list]
dict set ::pkg_errors [list $pkgname $requirements_list] "Version conflict for package \"$pkgname\": have $result, need $requirements_list"
#standard err msg but capital V to differentiate
#Differs from standard in that we have normalised exacts to ver-ver - so will report in that form instead of e.g 0-1 -exact 1.0 1b3-2
}
}
}
}
set actually_failed [interp eval normaltest [list set ::pkg_broken]]
set pkg_errors [interp eval normaltest [list set ::pkg_errors]] ;#dict
set actually_loaded [list]
set actually_loaded_names [list]
set actually_broken [list]
foreach pkgrequest $requested {
if {$pkgrequest in $missing} {
continue
}
if {$pkgrequest in $actually_failed} {
lappend actually_broken $pkgrequest
} else {
lappend actually_loaded $pkgrequest
if {[lindex $pkgrequest 0] ni $actually_loaded_names} {
lappend actually_loaded_names [lindex $pkgrequest 0]
}
}
}
dict for {pkg_req err} $pkg_errors {
dict set pkginfo $pkg_req error $err
}
interp delete normaltest
set pkgstate [dict create requested $requested loaded $actually_loaded loadednames $actually_loaded_names missing $missing broken $actually_broken info $pkginfo]
#debug
#dict for {k v} $pkgstate {
# puts stderr " - $k $v"
#}
return $pkgstate
}
#called when only-bootsupport or bootsupport+external module/lib paths active.
#flags for ui-feature relevant packages
proc ::punkboot::package_bools {pkg_availability} {
set pkgbools [dict create]
set requirements [dict create {*}{
overtype 1.6.5-
textblock 0.1.1-
punk::ansi 0.1.1-
}]
#'dict get $pkg_availability loaded] is a list of {pkgname requrement} pairs
#set loaded_names [lmap i [lsearch -all -index 0 -subindices [dict get $pkg_availability loaded] *] {lindex $loaded $i}] ;#return list of first elements in each tuple
set loaded_names [dict get $pkg_availability loadednames] ;#prebuilt list of names
dict for {pkgname req} $requirements {
#each req could in theory be a list
if {$pkgname in $loaded_names} {
#get first loaded match - use version from it (all info records for {pkgname *} should have same version that was actually loaded)
set first_loaded [lsearch -inline -index 0 [dict get $pkg_availability loaded] $pkgname]
set loaded_version [dict get $pkg_availability info $first_loaded version]
if {![llength $req] || [package vsatisfies $loaded_version {*}$req]} {
dict set pkgbools $pkgname 1
} else {
dict set pkgbools $pkgname 0
}
} else {
dict set pkgbools $pkgname 0
}
}
return $pkgbools
}
proc ::punkboot::get_display_missing_packages {pkg_availability} {
array set haspkg [punkboot::package_bools $pkg_availability] ;#convenience e.g if {$haspkg(textblock)} ...
global A
if {![array size A]} {
punkboot::define_global_ansi
}
set missing_rows [list]
set fields_blank_missing [dict create {*}{
status ""
package ""
version_requested ""
versions ""
optional ""
recommended ""
required_by ""
}]
foreach pkg_req [dict get $pkg_availability missing] {
lassign $pkg_req pkgname requirements_list
set fields $fields_blank_missing
dict set fields status "missing"
dict set fields package $pkg_req
if {[dict exists $::punkboot::bootsupport_optional $pkgname]} {
dict set fields optional " ${A(OK)}(known optional)$A(RST)"
}
if {[dict exists $::punkboot::bootsupport_recommended $pkgname]} {
dict set fields recommended "${A(HIGHLIGHT)}(RECOMMENDED)$A(RST)"
}
if {[dict exists $pkg_availability info $pkg_req required_by]} {
dict set fields required_by [dict get $pkg_availability info $pkg_req required_by]
}
lappend missing_rows $fields
}
set missing_out ""
set c1_width 40
foreach row $missing_rows {
if {$haspkg(overtype)} {
set line " [overtype::left [string repeat " " $c1_width] $A(BWHITE)[dict get $row package]$A(RST)]"
} else {
set line " [format "%-*s" $c1_width [dict get $row package]]"
}
append line " [dict get $row status]"
append line " [dict get $row optional]"
append line " [dict get $row recommended]"
append line " requested_by:[join [dict get $row required_by] {, }]"
append missing_out $line \n
}
return $missing_out
}
proc ::punkboot::get_display_broken_packages {pkg_availability} {
array set haspkg [punkboot::package_bools $pkg_availability] ;#convenience e.g if {$haspkg(textblock)} ...
global A
if {![array size A]} {
punkboot::define_global_ansi
}
set broken_rows [list]
set fields_blank_broken [dict create {*}{
status ""
package ""
version ""
optional ""
recommended ""
required_by ""
error ""
}]
foreach pkg_req [dict get $pkg_availability broken] {
lassign $pkg_req pkgname vrequested
set fields $fields_blank_broken
dict set fields status "broken"
dict set fields package $pkg_req
if {[dict exists $pkg_availability info $pkg_req version]} {
dict set fields version [dict get $pkg_availability info $pkg_req version]
}
if {[dict exist $::punkboot::bootsupport_optional $pkgname]} {
dict set fields optional "${A(OK)}(known optional)$A(RST)"
}
if {[dict exists $::punkboot::bootsupport_recommended $pkgname]} {
dict set fields recommended "${A(HIGHLIGHT)}(RECOMMENDED)$A(RST)"
}
set requiredby_list [list]
if {[dict exists $::punkboot::bootsupport_requirements $pkgname]} {
#punkboot also asked for this pkgname
#the question of what other packages would also be satisfied had this request not been broken isn't necessarily something we need to answer here
#we do so for punkboot anyway - but it's inclusion as 'requiredby or requestedby' isn't strictly accurate -
# it is more like: would also be satisfied by
#what is 'broken' may depend on what order packages were loaded
#e.g if a package already required a specific low version (that was optional for it) that another then fails on because a different version was not optional for that later package.
#puts stderr "$pkgname===$::punkboot::bootsupport_requirements"
set pboot_required [dict get $::punkboot::bootsupport_requirements $pkgname version] ;#version key always present and empty or normalised
if {[list $pkgname $pboot_required] eq $pkg_req} {
#pboot had same requirespec as this broken record
set requiredby_list [list punkboot]
} elseif {[dict exists $pkg_availability info $pkg_req version]} {
set vtried [dict get $pkg_availability info $pkg_req version]
if {[dict exists $pkg_availability broken [list $pkgname $pboot_required]]} {
#punkboot didn't get what it wanted directly
if {$pboot_required eq "" || [package vsatisfies $vtried $pboot_required]} {
#REVIEW
#e.g punkboot might require no specific version - and this fail record might be for a specific version
#we only list punkboot against this request if it's request also failed - but would be satisfied by this failure if it had worked
set requiredby_list [list punkboot]
}
}
}
}
if {[dict exists $pkg_availability info $pkg_req required_by]} {
lappend requiredby_list {*}[dict get $pkg_availability info $pkg_req required_by]
}
dict set fields required_by $requiredby_list
if {[dict exists $pkg_availability info $pkg_req error]} {
dict set fields error "[dict get $pkg_availability info $pkg_req error]"
}
lappend broken_rows $fields
}
set broken_out ""
set c1_width 40
set c3_width 20
set c3 [string repeat " " $c3_width]
foreach row $broken_rows {
if {$haspkg(overtype)} {
set line " [overtype::left [string repeat " " $c1_width] $A(BAD)[dict get $row package]$A(RST)]"
} else {
set line " [format "%-*s" $c1_width [dict get $row package]]"
}
append line " [dict get $row status]"
if {[dict get $row version] ne ""} {
set txt " ver:[dict get $row version]"
append line [format "%-*s" $c3_width $txt]
} else {
append line $c3
}
if {[dict get $row optional] ne ""} {
append line [dict get $row optional]
}
if {[dict get $row recommended] ne ""} {
append line [dict get $row recommended]
}
if {[dict get $row required_by] ne ""} {
append line " requested_by:[join [dict get $row required_by] {, }]"
}
if {[dict get $row error] ne ""} {
append line " err:[dict get $row error]"
}
append broken_out $line \n
}
return $broken_out
}
proc ::punkboot::define_global_ansi {} {
#stick to basic colours for themable aspects ?
#
set has_ansi [expr {[package provide punk::ansi] ne ""}]
global A
if {!$has_ansi} {
if {[info exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} {
set A(RST) ""
set A(HIGHLIGHT) ""
set A(BWHITE) ""
set A(OK) ""
set A(BAD) ""
set A(ERR) ""
} else {
set A(RST) \x1b\[m
set A(HIGHLIGHT) \x1b\[93m ;#brightyellow
set A(BWHITE) \x1b\[97m ;#brightwhite
set A(OK) \x1b\[92m ;#brightgreen
set A(BAD) \x1b\[33m ;# orange
set A(ERR) \x1b\[31m ;# red
}
} else {
namespace eval ::punkboot {
namespace import ::punk::ansi::a+ ::punk::ansi::a
}
if {[info exists ::punk::console::colour_disabled] && $::punk::console::colour_disabled} {
#G-113: the A() palette is colour-only highlighting - when colour is
#disabled every entry (including RST) is empty rather than relying on
#a+/a colour stripping (a bare reset would survive as a non-colour code).
set A(RST) ""
set A(HIGHLIGHT) ""
set A(BWHITE) ""
set A(OK) ""
set A(BAD) ""
set A(ERR) ""
} else {
set A(RST) [a]
set A(HIGHLIGHT) [a+ brightyellow]
set A(BWHITE) [a+ brightwhite]
set A(OK) [a+ web-lawngreen] ;#brightgreen
set A(BAD) [a+ web-orange]
set A(ERR) [a+ web-indianred] ;#easier on the eyes than standard red on some screens
}
}
}
proc ::punkboot::punkboot_gethelp {args} {
#we have currently restricted our package paths to those from 'bootsupport'
#gather details on what is missing so that the info is always reported in help output.
variable pkg_availability
global A
punkboot::define_global_ansi
array set haspkg [punkboot::package_bools $pkg_availability] ;#convenience e.g if {$haspkg(textblock)} ...
set scriptname [file tail [info script]]
append h "Usage:" \n
append h "" \n
append h " $scriptname -help or $scriptname --help or $scriptname /? or just $scriptname" \n
append h " - This help." \n \n
append h " $scriptname bakehouse ?-k? ?-dirty-abort 1|0?" \n
append h " - consumer build from a clean checkout: runs the packages stage (modules + libs) then bakes kit/zipkit executables to <projectdir>/bin" \n
append h " - refuses uncommitted src by default (-dirty-abort defaults ON: the bakehouse bakes from the committed recipe; pass -dirty-abort 0 to override)" \n
append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n
append h " - does NOT run the promotion gates (bootsupport, vfscommonupdate) - on a clean checkout they are already satisfied by the committed tree" \n \n
append h " $scriptname bake ?-k? ?kitname ...?" \n
append h " - assemble kit/zipkit executables from the promoted payload (src/vfs) and src/runtime runtimes into <projectdir>/bin" \n
append h " - includes the vfslibs phase; does not rebuild modules/libs and does not run the promotion gates" \n
append h " - with kitname arguments, bakes and deploys only the named configured kits (unknown names error before any build)" \n \n
append h " $scriptname bakelist ?kitname ...?" \n
append h " - list the kit outputs configured in src/runtime/mapvfs.config: name, kit type, runtime (with presence)," \n
append h " vfs folder and deployed state (bin copy absent/current/stale/nobuild vs the src/_build product)" \n
append h " - kitname arguments filter to the named entries (per-kit detail)" \n \n
append h " $scriptname modules" \n
append h " - build (or copy if build not required) .tm modules from src/modules src/vendormodules etc to their corresponding locations under <projectdir>" \n
append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n
append h " $scriptname libs" \n
append h " - build (or copy if build not required) pkgIndex.tcl based libraries from src/lib src/vendorlib etc to their corresponding locations under <projectdir>" \n
append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n
append h " $scriptname packages" \n
append h " - build (or copy if build not required) both .tm and pkgIndex.tcl based packages from src to their corresponding locations under <projectdir>" \n
append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n
append h " $scriptname bootsupport" \n
append h " - update the src/bootsupport modules" \n
append h " - bootsupport modules are pulled from locations specified in include_modules.config files within each src/bootsupport subdirectory" \n
append h " - project layouts store no bootsupport module snapshots: generated projects get bootsupport injected at generation time by 'dev project.new'" \n
append h " - This should usually be from modules that have been built and tested in <projectdir>/modules <projectdir>/lib etc." \n
append h " - bootsupport modules are available to make.tcl" \n \n
append h " $scriptname vendorupdate" \n
append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n
append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n
append h " $scriptname vfslibs" \n
append h " - propagate declared vendored platform-library packages into kit vfs lib_tcl<N> trees" \n
append h " - declarations (per-package per-kit, with superseded-version removal) live in src/runtime/vendorlib_vfs.toml" \n
append h " - also runs automatically as a phase of '$scriptname bake' (and therefore of '$scriptname bakehouse')" \n \n
append h " $scriptname vfscommonupdate" \n
append h " - promotion gate: update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n
append h " - before calling this (followed by '$scriptname bake') - you can test using '<builtexe>(.exe) dev'" \n
append h " this will load modules from your <projectdir>/module <projectdir>/lib paths instead of from the kit/zipkit" \n \n
append h " $scriptname info" \n
append h " - show the name and base folder of the project to be built" \n \n
append h " $scriptname check" \n
append h " - show module/library paths and any potentially problematic packages for running this script" \n
append h " $scriptname shell" \n
append h " - run the punk shell using bootsupport libraries." \n
append h " $scriptname projectversion" \n
append h " - advisory check: verify CHANGELOG.md matches punkproject.toml and warn if src/ has changes since the last project-version bump." \n \n
append h " $scriptname workflow" \n
append h " - print an ASCII data-flow overview of the build/release workflow (edit -> packages -> bootsupport -> kits)" \n \n
append h " $scriptname buildsuite list|info|build ?<suitename>? ?driver-args ...?" \n
append h " - list the defined buildsuites under src/buildsuites (zig runtime factory), show a suite's configured" \n
append h " detail (sources/zig pin/products from its sources.config), or run its driver forwarding the args" \n \n
append h " $scriptname tool list|info|build|test ?<toolname> ...? ?-test 0|1?" \n
append h " - vendored first-party build tools under src/tools (zig source; G-126): list/detail them, run their" \n
append h " test suites, or build (test-gated) and install to <projectdir>/bin" \n
append h " - zig is OPTIONAL: packages/bake never require this step; without a suitable toolchain the state is" \n
append h " reported and build/test exit nonzero with fetch guidance (bin/punk-getzig.cmd)" \n \n
append h " $scriptname help ?subcommand?" \n
append h " - show usage for $scriptname or one of its subcommands (equivalent: $scriptname <subcommand> -help)" \n \n
append h " Deprecated aliases (transition window):" \n
append h " $scriptname project -> runs bakehouse (with a one-line notice)" \n
append h " $scriptname vfs -> runs bake (with a one-line notice)" \n \n
append h " Flags:" \n
append h " -confirm 0|1" \n
append h " - interactive y/n confirmation policy (default 1: prompt when stdin is a terminal, abort fast when it is not)." \n
append h " Use -confirm 0 for unattended runs: the bootsupport minor-staleness gate and the vfscommonupdate REPLACE" \n
append h " confirmation proceed without prompting; kits with a source/target kit-type mismatch are skipped." \n
append h " -dirty-abort" \n
append h " - abort build/promotion commands (bakehouse packages modules libs bake vfslibs bin bootsupport vfscommonupdate) when src/ has" \n
append h " uncommitted VCS changes. Default is warn-only EXCEPT bakehouse (defaults ON there; -dirty-abort 0 overrides):" \n
append h " artifacts built from dirty src have no committed provenance." \n
append h " Warnings carry a plain PROVENANCE-WARNING: prefix (greppable in redirected output) and are recapped at the end of the run." \n
append h " Use '$scriptname check' to see the current provenance status. To evaluate uncommitted source without building," \n
append h " use '<builtexe> src' or '<builtexe> src shell'." \n \n
append h "" \n
append h [punkboot_availability_note]
return $h
}
#Embedded build/release workflow overview - the output of the 'workflow' subcommand.
#Embedded (rather than a data file) so it travels with make.tcl wherever it runs, including
#the make.tcl copies seeded into generated projects via the project layouts.
#Contract for updates (see also src/AGENTS.md 'Work Guidance'): when build data flow changes
#(subcommand added/removed/repurposed, source or output folder flow changed, new propagation
#target), this text changes in the same commit. Plain ASCII only, max line width 100.
proc ::punkboot::workflow_text {} {
set txt {
build & release workflow - from module edit to kits + bootsupport (punk project layout)
=============================================================================
Scope: data flow from editing a module under src/ through to a release-ready
rebuild (built packages, bootsupport refresh, kit vfs, kit executables).
All commands run from the projectroot with a native tclsh, e.g:
tclsh src/make.tcl <subcommand> -confirm 0 (see [K6])
TWO PERSONAS (stage-true subcommand model - one build stage, two promotion
gates, one bake)
----------------------------------------------------------------------------
CONSUMER (clean checkout, wants baked kits):
tclsh src/make.tcl bakehouse -confirm 0
= packages + bake in one uninterrupted run. The promotion gates are already
satisfied by the committed tree. bakehouse REFUSES uncommitted src by
default (-dirty-abort defaults ON: the bakehouse bakes from the committed
recipe; -dirty-abort 0 overrides).
DEVELOPER (changing payload): pass the gates explicitly - the commit is the
publishing act, not a build step. That is the RELEASE SEQUENCE below.
Deprecated aliases (transition window): 'project' -> bakehouse, 'vfs' -> bake.
RELEASE SEQUENCE (the developer order that satisfies the staleness + provenance gates)
----------------------------------------------------------------------------
(1) edit src/modules/foo-999999.0a1.0.tm code change [K1]
(2) bump src/modules/foo-buildversion.txt module version + changelog comment
punkproject.toml + CHANGELOG.md project version (if shipped behaviour) [K2]
(3) test tclsh src/tests/runtests.tcl ... runs against src/ trees (if present)
(4) commit source changes (git/fossil) clean tree -> committed provenance [K3]
(5) build tclsh src/make.tcl modules -confirm 0 (or 'packages' = modules + libs)
(6) build tclsh src/make.tcl bootsupport -confirm 0 run twice: 2nd pass must copy 0 files [K4]
(7) build tclsh src/make.tcl vfscommonupdate -confirm 0
(8) build tclsh src/make.tcl bake -confirm 0 kits; close running kit shells first [K5]
(9) commit tracked build outputs src/bootsupport, thin-layout script/
manifest copies (src/project_layouts +
templates modpod payload),
src/vfs/_vfscommon.vfs
DIAGRAM 1 - DATA FLOW: SOURCE -> BUILT PACKAGES -> PROPAGATION TARGETS
----------------------------------------------------------------------------
src/modules/foo-999999.0a1.0.tm [K1] src/lib/
src/modules/foo-buildversion.txt src/vendorlib/
src/vendormodules/ (+ *_tcl9 variants) |
| |
| make.tcl modules | make.tcl libs
| (stamp real version, pack #modpod-*, |
| prune superseded) |
v v
modules/ modules_tcl8/ modules_tcl9/ lib/ lib_tcl8/ lib_tcl9/
e.g. modules/foo-0.12.4.tm
== BUILT PACKAGES (projectroot output trees, punkcheck-recorded [K3]) ==
|
+--------------------------------------+
| |
| make.tcl bootsupport [K4] | make.tcl vfscommonupdate
| (curated subset) | (REPLACE semantics: vfs modules/libs
v | are overwritten with built set)
src/bootsupport/modules/ v
(the module set make.tcl itself src/vfs/_vfscommon.vfs/modules/ + libs
boots from; staleness-gated. (VCS-tracked kit payload source)
Project layouts store NO module |
snapshots - 'dev project.new' | make.tcl bake (kit-assembly stage;
injects bootsupport into generated v consumer umbrella: bakehouse)
projects from the generating src/_build/<kit>.exe --deploy--> bin/<kit>.exe
shell at generation time - G-087) (see DIAGRAM 2) [K5]
DIAGRAM 1b - THIN-LAYOUT SYNC (part of modules/libs/packages/bakehouse runs)
----------------------------------------------------------------------------
src/make.tcl src/build.tcl src/bootsupport/modules*/include_modules.config
|
| punkcheck-recorded copies into each vendor layout carrying src/make.tcl
v
src/project_layouts/vendor/punk/<layout>/src/... (thin layouts: scripts, docs,
| manifests - no module snapshots)
| store -> modpod payload sync (punk.project layout only; excludes bin/sdx.kit)
v
src/modules/punk/mix/#modpod-templates-*/templates/project_layouts/
(packed into the punk::mix::templates module by the modules build, so a bare
kit outside any project can list and generate the punk.project layout)
DIAGRAM 2 - KIT ASSEMBLY DETAIL (the 'make.tcl bake' stage; incl. vfslibs phase)
----------------------------------------------------------------------------
src/runtime/mapvfs.config which vfs folder pairs with which runtime -> kit name,
and optionally the TARGET PLATFORM of that runtime [K9]
'make.tcl bakelist ?kitname ...?' reports the configured
kit outputs (runtime/vfs presence + deployed state);
'make.tcl bake ?kitname ...?' bakes only the named kits
(bare bake = all; unknown names error before any build)
bin/runtime/<target>/<runtime> bare Tcl runtime (tclkit / tclsfe / suite build), in the
store tier of the TARGET platform it builds kits for [K9]
src/vfs/_vfscommon.vfs/ common payload (built modules + libs, main boot support)
src/vfs/<kitspecific>.vfs/ per-kit overlay (main.tcl, kit-only modules/config)
_vfscommon.vfs <kitspecific>.vfs
| |
+-----------+----------+
| copy common, then merge overlay over it
v
src/_build/<kit>.exe.vfs
|
| advisory payload/target binary-arch scan of the merged
| tree (wrong-arch libraries -> recapped BUILD-WARNING) [K11]
| boot-precondition gate: merged vfs must supply a tcl
| library (tcl_library/, lib/tcl<M>.<m>/, tcl<M>.<m>/) [K10]
v
(gate) --> refused: kit listed under FAILED KITS, nothing
| built, nothing deployed, bin/<kit> untouched
|
| kit icon step (G-057): <kit>.resources.toml sidecar records
| the icon choice for every target (default src/runtime/
| punkshell.ico; override = punkshell.ico in the kit's own .vfs
| folder, pre-merge); win32 targets on a twapi-capable host get
| the icon stamped into a per-kit copy of the raw runtime stub
| BEFORE the payload attach (non-PE target: not applicable;
| incapable host: distinct notice - sidecar written either way)
|
| zip image appended to the (stamped) runtime exe: tcl::zipfs::
| mkimg, or (driving tcl without zipfs, e.g 8.6) raw-runtime
| split + punk::zip::mkzip + concatenation - both mount the same
v
src/_build/<kit>.exe (+ <kit>.exe.resources.toml)
|
| smoke-require probe (host-runnable kits with declared
| packages): plain 'package require' inside the artifact [K11]
| deploy step: delete old bin/<kit>.exe, copy new one in
| (the resource sidecar deploys beside the kit)
v
bin/<kit>.exe <-- FAILS (kit listed under FAILED KITS) if a
running shell still holds the old exe [K5]
KEY / NOTES
----------------------------------------------------------------------------
[K1] Source modules carry the literal magic version 999999.0a1.0 in the filename.
The real version is the first line of the sibling <modulename>-buildversion.txt;
bump it per semver (patch=fix, minor=api add, major=breaking) and append a
'#<version> - ...' changelog comment line below it. The modules build stamps
the real version into the output filename and package provide.
(A project may carry manually-versioned exceptions - see src/modules/AGENTS.md
if present.)
[K2] Project version (punkproject.toml [project] version + matching CHANGELOG.md
entry) is change-driven: bump when the change ships user-visible behaviour.
Advisory check: tclsh src/make.tcl projectversion
[K3] Every build target root gets a .punkcheck file recording what was installed
from where (punkcheck provenance). Building from a tree with uncommitted
changes under src/ works but emits PROVENANCE-WARNINGs - commit source first
for release builds. Output-tree commits (step 9) come after the builds.
[K4] Bootsupport staleness gate: make.tcl compares tracked module versions in
src/bootsupport against built sources; a stale bootsupport makes other
subcommands warn/prompt/abort (per bump level) unless -confirm 0. After a
tracked module bump, refresh with 'make.tcl bootsupport' and rerun it until
a pass copies 0 files (a converged second pass also proves prune tooling ran).
[K5] The deploy step cannot replace a kit exe that is currently executing. Close
running kit shells before step 8, or rerun 'make.tcl bake -confirm 0'
afterwards - the freshly built kits wait in src/_build. punkcheck records
mean the rerun only redoes the failed deploys. When iterating on one kit,
'make.tcl bake <kitname>' rebuilds/deploys just that kit; 'make.tcl
bakelist' shows each configured kit's deployed state (bin vs src/_build).
[K6] All confirmation prompts follow -confirm: unattended/agent runs must pass
-confirm 0 (non-interactive stdin aborts fast at prompts; piping 'y' is
retired). 'make.tcl help <subcommand>' shows per-subcommand usage.
[K7] Testing hooks along the way:
- src/tests/runtests.tcl exercises the src/ trees directly (dev modules).
- '<builtkit>.exe dev' (or '<builtkit> src') runs a built shell against the
project dev modules - useful for testing built packages before they are
baked into kits via vfscommonupdate + bake.
[K8] What is VCS-tracked where (checkin targets after a build):
tracked: src/** (sources, src/bootsupport, src/project_layouts copies,
src/vfs/_vfscommon.vfs), punkproject.toml, CHANGELOG.md
untracked: modules*/ lib*/ at projectroot, src/_build/, bin/<kit>.exe
(bin/ scripts/tools are tracked; kit executables are not)
[K9] HOST vs TARGET platform (G-122). What a bake EMITS is keyed by the target
platform, never by the driving tclsh's personality: which bin/runtime/<tier>
holds the runtime, whether the runtime file and the built kit carry .exe, and
whether the pre-deploy sweep uses tasklist/taskkill or ps/kill. The default
target is this host's own platform - except a cygwin-family host (an
msys2/cygwin-runtime tclsh, which reports platform 'unix' on windows), which
targets win32. A mapvfs.config entry may declare its own target as a 4th
element and is then read from that platform's tier, named with its executable
convention, and (being unrunnable here) skipped by the process sweep.
'make.tcl check' prints the derivation; 'make.tcl bakelist' shows per-kit
targets, with a target= note on rows that are not on the default target.
[K10] BOOT-PRECONDITION gate (G-125). A kit whose merged vfs has no tcl library
cannot initialise at all ('Cannot find a usable init.tcl'), so the bake
refuses it: the kit is listed under FAILED KITS and NOTHING is written -
no src/_build/<kit>, no deploy, and the previously deployed bin/<kit> is
left exactly as it was. This is deliberately not a warning: the deploy step
deletes the old kit before copying the new one, so warning-and-proceeding
replaced a working shell with one that could not start. The check is
structural - init.tcl in tcl_library/, lib/tcl<major>.<minor>/ or
tcl<major>.<minor>/ (that last one for runtimes whose archive mounts at the
executable's own path rather than //zipfs:/app), plus a companion file so a
package's own init.tcl cannot answer for a tcl library - and runs on the
MERGED tree, not on whether extraction ran - a .vfs that
supplies its own tcl library builds and deploys as normal. Nothing is
executed, so cross-target kits are covered too. Usual cause: the runtime's
own payload could not be extracted - see the BUILD-WARNING naming what was
tried. 'make.tcl check' reports whether the gate is ACTIVE.
[K11] PAYLOAD/TARGET consistency checks (G-133), both ADVISORY - warnings recap at
end of run, the kit still builds and deploys. (a) Binary-arch scan at the same
seam as [K10]: each binary library (*.dll/*.so/*.dylib) in the merged tree is
classified by header (PE/ELF/Mach-O - structural, nothing executed, so
cross-target kits are covered) against the kit's target platform; wrong-arch
libraries outside platform-discriminated subdirs (win32-ix86/, win-x64/ etc -
multi-arch payloads are legitimate there) earn recapped BUILD-WARNINGs.
(b) Smoke-require probe: a kit declaring packages (mapvfs.config 5th entry
element) has each one plain-'package require'd INSIDE the freshly built
artifact via its tclsh subcommand - the only check that sees resolution-order
defects (a wrong-arch higher-versioned package shadowing a working copy);
cross-target kits skip with a stated reason, undeclared kits run nothing new.
What neither check guarantees: statically linked packages, pure-tcl packages
with binary dependencies, and version-preference outcomes are visible only to
the smoke probe - and only for declared packages. 'make.tcl check' reports both.
OUT-OF-BAND SUBSYSTEMS (not part of the packages/bake data flow above)
'make.tcl tool' builds the vendored first-party zig tools under src/tools
(G-126; punkzip first) into <projectdir>/bin, gated on each tree's own
'zig build test' exit code. zig is OPTIONAL: packages/bake never require it.
'make.tcl buildsuite' is the analogous arm's-length factory for whole Tcl
runtimes built from EXTERNAL sources under src/buildsuites (fetch + test-gate
contract per suite; products land in the bin/runtime store tiers).
MAINTENANCE (agents take note)
----------------------------------------------------------------------------
This text is embedded in make.tcl (::punkboot::workflow_text). When the build
data flow changes - a make.tcl subcommand added/removed/repurposed, a source or
output folder added or rerouted, a new propagation target, a changed gate or
deploy behaviour - update this text in the same change-set and verify with
'tclsh src/make.tcl workflow'. Plain ASCII only; max line width 100. A make.tcl
interface change is product surface: bump the project version (at least patch).
}
return [string trim $txt \n]
}
#Missing/broken bootsupport-package NOTE shown with help output.
#Factored out of punkboot_gethelp (G-030) so both the punk::args tabled help path and the
#plain-text fallback help append the same information. Returns "" when there is nothing to report.
proc ::punkboot::punkboot_availability_note {} {
variable pkg_availability
if {![info exists pkg_availability]} {
return ""
}
global A
if {![array size A]} {punkboot::define_global_ansi}
set h ""
if {[llength [dict get $pkg_availability missing]] || [llength [dict get $pkg_availability broken]]} {
set has_recommended 0
set has_nonoptional 0
foreach pkg_req [list {*}[dict get $pkg_availability missing] {*}[dict get $pkg_availability broken]] {
lassign $pkg_req pkgname _requirements
if {[dict exists $::punkboot::bootsupport_recommended $pkgname]} {
set has_recommended 1
break
}
if {![dict exists $::punkboot::bootsupport_optional $pkgname]} {
set has_nonoptional 1
break
}
}
if {$has_recommended || $has_nonoptional} {
append h "* $A(HIGHLIGHT)** NOTE ** ***$A(RST)" \n
append h " punk boot has detected that the following packages could not be loaded from the bootsystem path:" \n
set missing_out [get_display_missing_packages $pkg_availability]
append h $missing_out
set broken_out [get_display_broken_packages $pkg_availability]
append h $broken_out
append h "* $A(HIGHLIGHT)** *** *** ***$A(RST)" \n
append h " These packages are *probably* required for punk boot to function correctly and efficiently" \n
append h " punk boot may still work if they are available elsewhere for the running interpreter" \n
append h " Review to see if bootsupport should be updated" \n
append h " Call 'make.tcl check' and examine the last table (which includes bootsupport + executable-provided packages)" \n
append h " See if there are any items marked missing or broken that aren't marked as '(known optional)'" \n
append h " If all are marked (known optional) then it should work." \n
append h " A package marked (known optional) and (RECOMMENDED) may make the build/install processes run a lot faster. (e.g tcllibc)" \n
append h "* $A(HIGHLIGHT)** *** *** ***$A(RST)" \n\n
#append h "Successfully Loaded packages:" \n
#append h " " [join $::punkboot::pkg_loaded "\n "] \n
}
}
return $h
}
#todo? process and remove first arg dev os internal (and combinations such as dev-os etc)
##############################################################################################################
##############################################################################################################
##############################################################################################################
set scriptargs $::argv
# ----------------------------------------------------------------------------------------------
# G-030: make.tcl dogfoods punk::args.
# Subcommands and their options are declared as punk::args definitions ((script)::punkboot and
# (script)::punkboot::<subcommand>) and parsed with punk::args::parse - 'make.tcl',
# 'make.tcl help ?subcommand?' and 'make.tcl <subcommand> -help' render tabled usage, and invalid
# arguments produce punk::args usage errors.
# Degrade rule (hard requirement - see goals/archive/G-030-maketcl-punkargs.md): punk::args is
# guarded. When it (or a definition feature it needs) is unavailable from bootsupport, dispatch
# falls back to the self-contained scan below and help falls back to plain-text
# ::punkboot::punkboot_gethelp, so the environment-repair commands (check, bootsupport, modules)
# keep working. The tabled rendering additionally depends on the punk::ansi/textblock stack -
# rendering degrades independently of parsing (minimal errorstyle / plain fallback help) when
# that stack is unhealthy. Only punk::args itself joins the bootstrap-tracked staleness set
# (_runtime_deps above): it is the parsing contract; the rendering stack is left to degrade.
# ----------------------------------------------------------------------------------------------
set ::punkboot::punkargs_ok 0
#PUNKBOOT_PLAIN=1 forces the plain fallback dispatch/help - a troubleshooting/test hook for the
#degrade contract (e.g when a half-broken punk::args snapshot loads but misbehaves).
if {[info exists ::env(PUNKBOOT_PLAIN)] && [string is true -strict $::env(PUNKBOOT_PLAIN)]} {
puts stderr "make.tcl: PUNKBOOT_PLAIN set - using plain argument handling and help"
} elseif {![catch {package require punk::args}]} {
if {![catch {
namespace eval ::punkboot::argdoc {
#single source for the subcommand one-line summaries: each subcommand definition's
#@cmd -summary and the top-level subcommand -choicelabels are both built from this.
variable SUMMARIES {
bakehouse "Consumer build from a clean checkout: packages then bake - refuses uncommitted src by default"
packages "Build .tm modules and pkgIndex.tcl libraries from src into <projectdir> (no kit executables)"
modules "Build .tm modules from src/modules, src/vendormodules etc into <projectdir>/modules etc"
libs "Build pkgIndex.tcl libraries from src/lib, src/vendorlib etc into <projectdir>/lib etc"
bake "Assemble kit/zipkit executables from promoted payload (src/vfs) and runtimes into <projectdir>/bin"
bakelist "List the kit outputs configured in src/runtime/mapvfs.config: type, runtime/vfs presence, deployed state"
vfslibs "Propagate declared vendored platform-library packages into kit vfs lib_tcl<N> trees"
bin "Install executables from src/bin into <projectdir>/bin, then build kits as for bake"
vendorupdate "Update src/vendormodules based on src/vendormodules/include_modules.config"
bootsupport "Promotion gate: update src/bootsupport modules from built project modules"
vfscommonupdate "Promotion gate: replace src/vfs/_vfscommon.vfs modules and libs with the project's built set"
info "Show the name and base folder of the project to be built"
check "Show module/library paths and any potentially problematic packages for running this script"
projectversion "Advisory check: CHANGELOG.md vs punkproject.toml and src/ changes since last version bump"
workflow "Print an ASCII data-flow overview of the build/release workflow (edit -> packages -> gates -> bake)"
shell "Run the punk shell using bootsupport libraries"
help "Show usage for make.tcl or one of its subcommands"
buildsuite "List, describe or run the defined buildsuites under src/buildsuites (zig runtime factory)"
tool "List, test or build the vendored tools under src/tools (zig) and install them to <projectdir>/bin"
project "DEPRECATED alias for bakehouse (one-line notice, then runs bakehouse)"
vfs "DEPRECATED alias for bake (one-line notice, then runs bake)"
}
#@cmd -help bodies for the constructed definitions below. Authored BLOCK-FORM
#(first value line whitespace-only) so the @normalize directive in each
#definition re-bases the embedded source indentation - the G-045 mechanism for
#string-built definitions, which get no automatic whole-block indent
#normalization (head-form values here would leak this file's indentation into
#the rendered Description column).
variable HELPTEXTS {
bakehouse
"
Consumer umbrella: run the packages stage (modules + libs) then bake
the kit/zipkit executables - the full path from a CLEAN checkout to
installed kits in <projectdir>/bin.
The bakehouse bakes from the committed recipe: by default it refuses
to run when src/ has uncommitted changes (-dirty-abort defaults ON),
pointing at the granular developer flow (packages -> test ->
bootsupport/vfscommonupdate -> commit -> bake). Pass -dirty-abort 0
to build anyway with PROVENANCE-WARNINGs.
Deliberately does NOT run the promotion gates (bootsupport,
vfscommonupdate): payload promotion is a confirm-gated, committed
act - on a clean checkout the gates are already satisfied by the
committed tree."
packages
"
Build (or copy if build not required) both .tm and pkgIndex.tcl based
packages from src to their corresponding locations under <projectdir>.
This does not scan src/runtime and src/vfs folders to build kit/zipkit
executables."
modules
"
Build (or copy if build not required) .tm modules from src/modules,
src/vendormodules etc to their corresponding locations under <projectdir>.
This does not scan src/runtime and src/vfs folders to build kit/zipkit
executables."
libs
"
Build (or copy if build not required) pkgIndex.tcl based libraries from
src/lib, src/vendorlib etc to their corresponding locations under
<projectdir>.
This does not scan src/runtime and src/vfs folders to build kit/zipkit
executables."
bake
"
Assemble kit/zipkit executables: scan src/vfs and src/runtime folders,
build each configured kit from the promoted payload
(src/vfs/_vfscommon.vfs + custom vfs folders) and its runtime, and
install to <projectdir>/bin.
With kitname arguments, bake and deploy ONLY the named configured
kits (see 'make.tcl bakelist' for the configured names) - other
kits' build products, bin copies and punkcheck records are left
untouched. An unknown name errors before any build, listing the
configured names. Bare 'bake' processes all configured kits.
Includes the vfslibs phase (declared vendored platform-library
propagation into kit vfs lib_tcl<N> trees) so a bake cannot ship
stale binary libs; a selective bake narrows that phase to the
named kits' vfs folders.
Does not rebuild modules/libs and does not run the promotion gates -
built modules reach the kit payload only via 'make.tcl
vfscommonupdate' (committed for provenance). Consumer full path from
a clean checkout: 'make.tcl bakehouse'."
bakelist
"
List the kit outputs configured in src/runtime/mapvfs.config (the
same parsed mapping the bake subcommand consumes): kit name, kit
type (kit|zip|zipcat...), runtime with presence in the runtime
store of that kit's TARGET platform
(<projectdir>/bin/runtime/<target>), vfs folder, and the
deployed state of <projectdir>/bin/<kit> vs the src/_build build
product:
current - deployed copy is identical to the build product
stale - deployed copy differs from the build product
absent - no deployed copy in <projectdir>/bin
nobuild - deployed copy exists but no build product to compare
A trailing notes column flags anomalies (runtime=missing,
vfs=missing, rtrev=r<cur><r<max> when the runtime working copy is
materialized from an older revision than a -r<N> artifact beside
it) and marks cross-target entries (target=<platform> on any kit
whose mapvfs entry declares a target other than this host's
default - 'make.tcl check' shows that default).
kitname arguments filter the report to the named entries (per-kit
detail, with resolved store tier, target and paths). Reporting
only - never builds."
vfslibs
"
Propagate declared vendored platform-library packages into kit vfs
lib_tcl<N> trees.
Declarations (per-package per-kit, with superseded-version removal)
live in src/runtime/vendorlib_vfs.toml.
Also runs automatically as a phase of 'make.tcl bake' (and therefore
of 'make.tcl bakehouse'); this standalone narrowing serves quick
iteration on the declarations."
bin
"
Install executables from src/bin to <projectdir>/bin, then check vfs
folders and build kit/zipkit executables as for the bake subcommand."
vendorupdate
"
Update the src/vendormodules based on src/vendormodules/include_modules.config.
Update the src/vendorlib based on src/vendorlib/config.toml (todo)."
bootsupport
"
Update the src/bootsupport modules.
Bootsupport modules are pulled from locations specified in
include_modules.config files within each src/bootsupport subdirectory.
This should usually be from modules that have been built and tested in
<projectdir>/modules, <projectdir>/lib etc.
Bootsupport modules are available to make.tcl.
Project layouts store no bootsupport module snapshots - generated
projects get bootsupport injected at generation time by 'dev
project.new' (G-087)."
vfscommonupdate
"
Update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc.
Before calling this (followed by 'make.tcl bake') - you can test using
'<builtexe>(.exe) dev' - this will load modules from your <projectdir>/modules,
<projectdir>/lib paths instead of from the kit/zipkit.
Replacing the _vfscommon.vfs contents requires confirmation - see -confirm."
info
"
Show the name and base folder of the project to be built."
check
"
Show module/library paths and any potentially problematic packages for
running this script.
Also reports the colour policy, the host/target platform derivation
(this tclsh's platform canon vs the default kit target, its runtime
store tier, executable suffix and process tooling), bootsupport
staleness and the src provenance status (what the build/promotion
commands would do)."
projectversion
"
Advisory check: verify CHANGELOG.md matches punkproject.toml and warn
if src/ has changes since the last project-version bump."
workflow
"
Print a plain-text (ASCII diagram) overview of the build/release
workflow: the release-ready command sequence and how data flows from
editing a module under src/ through built packages to bootsupport,
the kit vfs and the kit executables.
The text is embedded in make.tcl (::punkboot::workflow_text) so it is
available wherever make.tcl runs; its MAINTENANCE key states the
update contract for keeping it in step with build behaviour."
buildsuite
"
Surface for the defined buildsuites under src/buildsuites (zig-built
runtime factory - an arm's-length subsystem building Tcl runtimes
from external sources, distinct from the project build/bake stages).
Actions:
buildsuite list
Discover the suites (directories carrying a suite.tcl driver;
_build excluded) with their one-line descriptions.
buildsuite info <name>
Show the suite's configured detail: description, source records
(name/kind/url/ref/dir from sources.config), pinned zig and its
resolution, products, doc pointers.
buildsuite build <name> ?driver-args ...?
Run the suite's driver ('suite.tcl build' with the given args
forwarded untouched, e.g -tclbranch/-refresh/-steps), streaming
its output and exiting with the driver's status.
Suites are SELF-describing: list/info read each suite's
sources.config records (description/product/doc/zigpin - the same
manifest the suite.tcl driver parses), so a copied/retargeted tree
(copy-and-tweak workflow) appears here automatically with no
make.tcl edits. The contract is documented in
src/buildsuites/README.md."
tool
"
Surface for the vendored first-party build tools under src/tools
(G-126: zig source vendored in full; boundary and editing policy in
src/tools/AGENTS.md, per-tree origin/licence records in
<tool>/PROVENANCE.md). Discovery is convention-based: a directory
under src/tools carrying build.zig is a tool; its installed
artifact is <projectdir>/bin/<name> with the host executable
suffix.
Actions:
tool list
Discover the tools with version (build.zig.zon), declared zig
floor, installed-binary state (current|stale|absent) and the
vendored upstream commit; report the resolved toolchain.
tool info <name> ...
Per-tool detail: paths, provenance records, toolchain
resolution.
tool build ?<name> ...? ?-test 0|1?
Resolve a zig satisfying the tool's declared floor, run the
'zig build test' gate (default on; the gate is the EXIT CODE -
expected warnings on stderr do not fail it), build ReleaseSafe
and install to <projectdir>/bin. Nothing is installed when the
gate or the build fails. With no name, all tools are
processed.
tool test ?<name> ...?
Run each tool's 'zig build test' only.
Toolchain resolution: PUNK_ZIG=<path-to-zig-or-its-folder>
overrides; otherwise <projectdir>/bin/tools/zig* is scanned and
the LOWEST release satisfying the floor wins (deterministic as
newer toolchains appear beside the pinned one; dev builds count
only when their base version exceeds the floor). zig is OPTIONAL
for punkshell builds: packages/bake never require this step -
without a suitable toolchain, list reports the state and
build/test exit nonzero with fetch guidance
(bin/punk-getzig.cmd). Build caches (.zig-cache/zig-out) are
deliberately left in place between runs for rebuild speed (both
git- and fossil-ignored)."
project
"
DEPRECATED alias for 'bakehouse' (G-112 stage-true rename) - prints a
one-line notice and runs bakehouse (packages + bake, -dirty-abort
default ON). Retained for a transition window."
vfs
"
DEPRECATED alias for 'bake' (G-112 stage-true rename) - prints a
one-line notice and runs bake (kit assembly including the vfslibs
phase). Retained for a transition window."
}
#shared option fragments composed into the per-subcommand definitions below
variable OPT_CONFIRM {
-confirm -type boolean -default 1 -help\
"Interactive y/n confirmation policy.
-confirm 1 (default): confirmation points prompt when stdin is an
interactive terminal. When stdin is NOT interactive (piped/closed),
make.tcl aborts fast at the confirmation point with guidance instead
of reading stdin.
-confirm 0: never prompt - each confirmation point takes its documented
non-interactive resolution:
bootsupport minor-version staleness gate -> proceed
vfscommonupdate REPLACE confirmation -> proceed
kit source/target type mismatch -> skip building that kit
Note: Tcl 8.6 lacks the terminal probe (-inputmode) so stdin is assumed
interactive there - piped runs under 8.6 should always pass -confirm
explicitly."
}
variable OPT_DIRTYABORT {
-dirty-abort -type none -default 0 -help\
"Abort when src/ has uncommitted VCS changes.
Default is warn-only: artifacts built from dirty src have no committed
provenance. Warnings carry a plain PROVENANCE-WARNING: prefix (greppable
in redirected output) and are recapped at the end of the run.
Use 'make.tcl check' to see the current provenance status. To evaluate
uncommitted source without building, use '<builtexe> src' or
'<builtexe> src shell'."
}
variable OPT_FORCEKILL {
-k -type none -default 0 -help\
"Terminate running processes matching the executable being built
(if applicable) so the build can install over it."
}
#bakehouse (and its deprecated alias project) defaults the dirty gate ON:
#the bakehouse bakes from the committed recipe (G-112 two-persona model).
variable OPT_DIRTYABORT_ON {
-dirty-abort -type boolean -default 1 -help\
"Abort when src/ has uncommitted VCS changes - DEFAULT ON for this
subcommand: the bakehouse bakes from the committed recipe. A
consumer build on a clean checkout runs uninterrupted; uncommitted
developer changes get a refusal naming the granular flow
(packages -> test -> bootsupport/vfscommonupdate -> commit -> bake).
Pass -dirty-abort 0 to build anyway with PROVENANCE-WARNINGs."
}
#which shared option fragments each subcommand declares
#(shell and help have bespoke definitions below: shell passes trailing args
# through to the repl untouched, help takes a subject value)
variable SUBOPTS {
bakehouse {OPT_FORCEKILL OPT_DIRTYABORT_ON OPT_CONFIRM}
packages {OPT_DIRTYABORT OPT_CONFIRM}
modules {OPT_DIRTYABORT OPT_CONFIRM}
libs {OPT_DIRTYABORT OPT_CONFIRM}
bake {OPT_FORCEKILL OPT_DIRTYABORT OPT_CONFIRM}
bakelist {}
vfslibs {OPT_DIRTYABORT OPT_CONFIRM}
bin {OPT_FORCEKILL OPT_DIRTYABORT OPT_CONFIRM}
vendorupdate {OPT_CONFIRM}
bootsupport {OPT_DIRTYABORT OPT_CONFIRM}
vfscommonupdate {OPT_DIRTYABORT OPT_CONFIRM}
info {OPT_CONFIRM}
check {}
projectversion {}
workflow {}
project {OPT_FORCEKILL OPT_DIRTYABORT_ON OPT_CONFIRM}
vfs {OPT_FORCEKILL OPT_DIRTYABORT OPT_CONFIRM}
}
#synopsis fragments matching the shared option fragments (explicit @form -synopsis
#so usage shows the real invocation 'make.tcl <subcommand> ...' rather than the
#internal definition id)
variable OPT_SYNOPSES {
OPT_FORCEKILL "?-k?"
OPT_DIRTYABORT "?-dirty-abort?"
OPT_DIRTYABORT_ON "?-dirty-abort 1|0?"
OPT_CONFIRM "?-confirm 0|1?"
}
#per-subcommand positional values (default: none). bake (and its deprecated
#alias vfs) and bakelist take optional kit names (G-121 selective bake).
#Discoverability nicety: the configured kit names are offered as choices when
#the mapping parses at definition time - informational only (-choicerestricted
#0), so the handlers' own validation (which lists the configured names, and
#still works when the mapping cannot be parsed here) stays authoritative.
variable KITNAME_CHOICES [list]
catch {
set _mapmodel [punkboot::lib::mapvfs_parse [file join $::punkboot::scriptfolder runtime mapvfs.config] "" $::punkboot::scriptfolder $::punkboot::target_platform]
foreach _rec [punkboot::lib::mapvfs_kit_outputs $_mapmodel "" $::punkboot::scriptfolder] {
lappend KITNAME_CHOICES [dict get $_rec kitname]
}
}
set _kitname_choicepart ""
if {[llength $KITNAME_CHOICES]} {
set _kitname_choicepart " -choices [list $KITNAME_CHOICES] -choicerestricted 0"
}
variable SUBVALUES [dict create]
dict set SUBVALUES bake [list\
"@values -min 0 -max -1"\
"kitname -type string -optional 1 -multiple 1${_kitname_choicepart} -help\
{
Configured kit output(s) to bake and deploy - see 'make.tcl bakelist'
for the configured names. With no kitname, all configured kits are
processed. An unknown name errors before any build.}"\
]
dict set SUBVALUES vfs [dict get $SUBVALUES bake]
dict set SUBVALUES bakelist [list\
"@values -min 0 -max -1"\
"kitname -type string -optional 1 -multiple 1${_kitname_choicepart} -help\
{
Configured kit output(s) to report on (filters the listing - doubles
as per-kit detail). With no kitname, all configured entries are
listed.}"\
]
variable VALUES_SYNOPSES {
bake "?kitname ...?"
vfs "?kitname ...?"
bakelist "?kitname ...?"
}
foreach {sub optvars} $SUBOPTS {
set synparts [list "make.tcl $sub"]
foreach ov $optvars {
lappend synparts [dict get $OPT_SYNOPSES $ov]
}
if {[dict exists $VALUES_SYNOPSES $sub]} {
lappend synparts [dict get $VALUES_SYNOPSES $sub]
}
set defparts [list]
lappend defparts "@id -id (script)::punkboot::$sub"
lappend defparts "@normalize" ;#G-045 block-form value re-basing for constructed definitions
lappend defparts "@cmd -name [list "make.tcl $sub"] -summary [list [dict get $SUMMARIES $sub]] -help [list [dict get $HELPTEXTS $sub]]"
lappend defparts "@form -synopsis [list [join $synparts { }]]"
lappend defparts "@opts"
foreach ov $optvars {
lappend defparts [set $ov]
}
if {[dict exists $SUBVALUES $sub]} {
foreach vp [dict get $SUBVALUES $sub] {
lappend defparts $vp
}
} else {
lappend defparts "@values -min 0 -max 0"
}
punk::args::define {*}$defparts
}
punk::args::define\
"@id -id (script)::punkboot::shell"\
"@normalize"\
"@cmd -name [list "make.tcl shell"] -summary [list [dict get $SUMMARIES shell]] -help [list\
"
Run the punk shell (repl) using bootsupport libraries.
All arguments after the shell subcommand are passed through to the
repl untouched (they are not parsed or validated by make.tcl)."]"\
{@form -synopsis "make.tcl shell ?arg ...?"}\
{@values -min 0 -max -1
arg -type any -optional 1 -multiple 1 -help\
"Arguments passed through to the punk repl."}
punk::args::define\
"@id -id (script)::punkboot::buildsuite"\
"@normalize"\
"@cmd -name [list "make.tcl buildsuite"] -summary [list [dict get $SUMMARIES buildsuite]] -help [list [dict get $HELPTEXTS buildsuite]]"\
{@form -synopsis "make.tcl buildsuite list|info|build ?<suitename>? ?driver-args ...?"}\
{@values -min 0 -max -1
arg -type any -optional 1 -multiple 1 -help\
"Action (list|info|build), suite name, and - for build - driver
arguments forwarded to the suite's suite.tcl untouched."}
punk::args::define\
"@id -id (script)::punkboot::tool"\
"@normalize"\
"@cmd -name [list "make.tcl tool"] -summary [list [dict get $SUMMARIES tool]] -help [list [dict get $HELPTEXTS tool]]"\
{@form -synopsis "make.tcl tool list|info|build|test ?<toolname> ...? ?-test 0|1?"}\
{@values -min 0 -max -1
arg -type any -optional 1 -multiple 1 -help\
"Action (list|info|build|test), tool name(s), and - for build -
the -test 0|1 gate flag. Parsed by the handler."}
punk::args::define\
"@id -id (script)::punkboot::help"\
"@normalize"\
"@cmd -name [list "make.tcl help"] -summary [list [dict get $SUMMARIES help]] -help [list\
"
Show tabled usage for make.tcl as a whole, or for a single subcommand.
Equivalent to 'make.tcl <subcommand> -help'."]"\
{@form -synopsis "make.tcl help ?subcommand?"}\
"@values -min 1 -max 1"\
"subject -type string -optional 0 -choices [list [dict keys $SUMMARIES]] -help {Subcommand to show usage for.}"
#top-level definition: the subcommand table rendered by 'make.tcl' / 'make.tcl -help'
variable SUBGROUPS {
"build & bake" {bakehouse packages modules libs bake vfslibs bin}
"promotion gates" {bootsupport vfscommonupdate}
"source maintenance" {vendorupdate}
"buildsuites" {buildsuite}
"vendored tools" {tool}
"informational" {info check bakelist projectversion workflow help}
"interactive" {shell}
"deprecated aliases" {project vfs}
}
punk::args::define\
"@id -id (script)::punkboot"\
"@normalize"\
"@cmd -name make.tcl -summary {punkshell project build tool (punk boot)} -help [list\
"
punk boot: make any tclkits and modules in <projectdir>/src folders and place
them and associated data files/scripts in the parent folder of src - e.g in
'bin' and 'modules' folders at the same level as 'src'.
General usage: make.tcl <subcommand> ?flags?
'make.tcl help <subcommand>' or 'make.tcl <subcommand> -help' shows a
subcommand's own usage. Interactive y/n confirmations can be driven
non-interactively with the -confirm flag declared on the relevant
subcommands."]"\
{@form -synopsis "make.tcl ?subcommand? ?flags?"}\
"@leaders -min 1 -max 1"\
"subcommand -type string -optional 0 -choicecolumns 1 -choicegroups [list $SUBGROUPS] -choicelabels [list $SUMMARIES] -help\
{Use 'make.tcl help <subcommand>' or 'make.tcl <subcommand> -help' for details of a subcommand.}"
#capability probe: force resolution of representative definitions now, inside
#the guarded block - a stale punk::args that accepted the raw text but cannot
#resolve a mechanism used here (e.g pre-@normalize snapshots) degrades to the
#plain fallback immediately instead of erroring at first parse/usage.
punk::args::get_spec (script)::punkboot
punk::args::get_spec (script)::punkboot::bakehouse
punk::args::get_spec (script)::punkboot::bake ;#exercises the G-121 kitname values spec (-choicerestricted mechanism)
punk::args::get_spec (script)::punkboot::help
punk::args::get_spec (script)::punkboot::shell
unset -nocomplain sub optvars defparts ov vp _mapmodel _rec _kitname_choicepart
}
} _defserr]} {
set ::punkboot::punkargs_ok 1
} else {
puts stderr "make.tcl: punk::args subcommand definitions failed to load ($_defserr) - falling back to plain argument handling"
}
}
#error/usage rendering style: tabled (enhanced) when the rendering stack is healthy,
#minimal plain text otherwise - rendering degrades independently of parsing.
set ::punkboot::errstyle minimal
if {$::punkboot::punkargs_ok && [package provide punk::ansi] ne "" && [package provide textblock] ne ""} {
set ::punkboot::errstyle enhanced
}
set do_help 0
set help_subject ""
set help_exitcode 0
#defaults for the option-derived variables (fallback scan and passthrough subcommands rely on these)
set ::punkboot::opt_forcekill 0
set ::punkboot::opt_dirty_abort 0
set ::punkboot::opt_confirm 1
set ::punkboot::opt_kitnames [list] ;#G-121: requested kit names for bake/bakelist (empty = all configured)
if {$::punkboot::punkargs_ok} {
set first [lindex $scriptargs 0]
if {![llength $scriptargs] || $first in $::punkboot::help_flags} {
set do_help 1
} else {
#validate/resolve the subcommand word via the top-level definition
#(allows unambiguous prefixes; unknown subcommands get a punk::args usage error)
if {[catch {punk::args::parse [list $first] -errorstyle $::punkboot::errstyle withid (script)::punkboot} argd]} {
puts stderr $argd
exit 1
}
set subcommand [dict get $argd leaders subcommand]
set subargs [lrange $scriptargs 1 end]
set wants_help 0
foreach h $::punkboot::help_flags {
if {$h in $subargs} {set wants_help 1 ; break}
}
if {$subcommand eq "help"} {
set do_help 1
if {[llength $subargs]} {
if {[catch {punk::args::parse $subargs -errorstyle $::punkboot::errstyle withid (script)::punkboot::help} argd]} {
puts stderr $argd
exit 1
}
set help_subject [dict get $argd values subject]
}
} elseif {$wants_help} {
set do_help 1
set help_subject $subcommand
} elseif {$subcommand eq "shell"} {
#declared passthrough: everything after 'shell' goes to the repl unparsed
set ::punkboot::command shell
} elseif {$subcommand eq "buildsuite"} {
#declared passthrough: the handler parses action/name itself; driver
#args (arbitrary suite flags) are forwarded untouched (G-104)
set ::punkboot::command buildsuite
set ::punkboot::bs_args $subargs
} elseif {$subcommand eq "tool"} {
#declared passthrough: the handler parses action/names/-test itself (G-126)
set ::punkboot::command tool
set ::punkboot::tool_args $subargs
} else {
if {[catch {punk::args::parse $subargs -errorstyle $::punkboot::errstyle withid (script)::punkboot::$subcommand} argd]} {
puts stderr $argd
exit 1
}
set ::punkboot::command $subcommand
set _opts [dict get $argd opts]
foreach {_optname _var} {-k opt_forcekill -dirty-abort opt_dirty_abort -confirm opt_confirm} {
if {[dict exists $_opts $_optname]} {
set ::punkboot::$_var [dict get $_opts $_optname]
}
}
if {[dict exists $argd values kitname]} {
#declared -multiple: a list of the supplied kit names (bake/vfs/bakelist - G-121)
set ::punkboot::opt_kitnames [dict get $argd values kitname]
}
unset -nocomplain _opts _optname _var
}
}
} else {
#self-contained fallback scan (degraded mode: punk::args or a needed definition feature
#unavailable). Keeps check/bootsupport/modules and the -k/-dirty-abort/-confirm flags working.
set commands_found [list]
set argsleft $scriptargs
if {[lindex $scriptargs 0] eq "buildsuite"} {
#declared passthrough (as in the punk::args path): driver args carry
#arbitrary suite flags the fallback flag scan must not consume (G-104)
set commands_found [list buildsuite]
set argsleft [list]
set ::punkboot::bs_args [lrange $scriptargs 1 end]
} elseif {[lindex $scriptargs 0] eq "tool"} {
#declared passthrough (as in the punk::args path) - the handler parses
#action/names/-test itself (G-126)
set commands_found [list tool]
set argsleft [list]
set ::punkboot::tool_args [lrange $scriptargs 1 end]
}
while {[llength $argsleft]} {
set a [lindex $argsleft 0]
set argsleft [lrange $argsleft 1 end]
if {[string match -* $a] || $a eq "/?"} {
switch -- $a {
-k {set ::punkboot::opt_forcekill 1}
-dirty-abort {set ::punkboot::opt_dirty_abort 1}
-confirm {
set v [lindex $argsleft 0]
set argsleft [lrange $argsleft 1 end]
if {![string is boolean -strict $v]} {
puts stderr "make.tcl: -confirm requires a boolean value (got '$v')"
exit 1
}
set ::punkboot::opt_confirm [expr {bool($v)}]
}
default {
if {$a in $::punkboot::help_flags} {
set do_help 1
} else {
puts stderr "Unknown flag: $a\n"
set do_help 1
set help_exitcode 1
}
}
}
} else {
lappend commands_found $a
}
}
#G-121: bake/bakelist (and the deprecated alias vfs) take optional trailing kit
#names - collect them here so the single-command check below still holds in
#degraded mode (the handlers do their own name validation).
if {[lindex $commands_found 0] in {bake bakelist vfs}} {
set ::punkboot::opt_kitnames [lrange $commands_found 1 end]
set commands_found [lrange $commands_found 0 0]
}
if {![llength $scriptargs] || [lindex $commands_found 0] eq "help"} {
set do_help 1
} elseif {!$do_help} {
if {[llength $commands_found] != 1} {
set do_help 1
set help_exitcode 1
} elseif {[lindex $commands_found 0] ni $::punkboot::known_commands} {
puts stderr "Unknown command: [lindex $commands_found 0]\n\n"
set do_help 1
set help_exitcode 1
}
}
if {!$do_help} {
set ::punkboot::command [lindex $commands_found 0]
}
}
if {$do_help} {
puts stdout "Checking package availability..."
set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements]
foreach pkg_request [dict get $::punkboot::pkg_availability loaded] {
lassign $pkg_request pkgname vrequest
package require $pkgname {*}$vrequest ;#todo
}
set help_shown 0
if {$::punkboot::punkargs_ok} {
#tabled usage via punk::args - degrade to the plain fallback help if the rendering
#stack (punk::ansi/textblock etc) can't produce it
set usage_id (script)::punkboot
if {$help_subject ne ""} {
set usage_id (script)::punkboot::$help_subject
}
if {![catch {punk::args::usage $usage_id} usage_out]} {
puts stdout $usage_out
set availability_note [::punkboot::punkboot_availability_note]
if {$availability_note ne ""} {
puts stdout $availability_note
}
set help_shown 1
} else {
puts stderr "make.tcl: punk::args tabled usage unavailable ($usage_out) - falling back to plain help"
}
}
if {!$help_shown} {
puts stdout [::punkboot::punkboot_gethelp]
}
exit $help_exitcode
}
#G-112 deprecated aliases - one-line mapping before any dispatch:
# project -> bakehouse (packages + bake, -dirty-abort default ON)
# vfs -> bake (kit assembly including the vfslibs phase)
#Kept for a transition window (until the 8.6 arc completes - see the G-112
#dispositions). The alias definitions above mirror their targets' options so
#flags parse identically; only the command word maps here.
if {[info exists ::punkboot::command]} {
switch -- $::punkboot::command {
project {
puts stderr "make.tcl: 'project' is DEPRECATED - use 'bakehouse' (packages + bake; refuses uncommitted src by default). Running bakehouse."
set ::punkboot::command bakehouse
}
vfs {
puts stderr "make.tcl: 'vfs' is DEPRECATED - use 'bake' (kit assembly incl. the vfslibs phase). Running bake."
set ::punkboot::command bake
}
}
if {!$::punkboot::punkargs_ok && $::punkboot::command eq "bakehouse"} {
#degraded fallback scan has flag-only -dirty-abort (no way to pass 0):
#bakehouse's documented default is ON, so force it here.
set ::punkboot::opt_dirty_abort 1
}
}
set forcekill $::punkboot::opt_forcekill
#puts stdout "::argv $::argv"
# ----------------------------------------
# Abort / prompt if bootsupport modules are stale relative to source.
# Behaviour is version-aware based on the bump level between each stale
# module's bootsupport version and source version:
# - major bump -> abort unconditionally (breaking change, old bootsupport will not work)
# - minor bump -> prompt user; backward-compat aliases *should* keep old bootsupport functional
# - patch bump -> warn and proceed (non-breaking)
# 'check' is exempt in all cases — the warning is shown at the end of its output instead.
# 'projectversion', 'workflow' and 'bakelist' are informational/read-only and are likewise exempt.
# 'buildsuite' and 'tool' are arm's-length subsystems that do not consume bootsupport modules.
if {[info exists ::punkboot::stale_bootsupport] && $::punkboot::command ni {check projectversion workflow bakelist buildsuite tool}} {
set _stale $::punkboot::stale_bootsupport
set _have_major 0
set _have_minor 0
set _have_patch 0
foreach _entry $_stale {
lassign $_entry _pkg _src_ver _bs_ver _bump
switch -- $_bump {
major {incr _have_major}
minor {incr _have_minor}
patch {incr _have_patch}
default {incr _have_patch}
}
}
puts stderr "=============================================================================="
puts stderr "WARNING: bootsupport modules are stale relative to source modules:"
foreach _entry $_stale {
lassign $_entry _pkg _src_ver _bs_ver _bump
puts stderr [format " %-15s bootsupport=%-10s source=%-10s bump=%s" $_pkg $_bs_ver $_src_ver $_bump]
}
puts stderr ""
puts stderr " Recommended fix — update bootsupport before proceeding:"
puts stderr " cd \[projectroot\]/src && tclsh make.tcl modules && tclsh make.tcl bootsupport"
puts stderr "=============================================================================="
if {$_have_major} {
puts stderr "-aborted- (major version bump in stale bootsupport — breaking change, cannot proceed)"
exit 1
}
if {$_have_minor} {
#G-030 prompt policy: -confirm 0 proceeds without prompting; with the default -confirm 1
#a non-interactive stdin aborts fast with guidance instead of reading stdin.
if {!$::punkboot::opt_confirm} {
puts stderr "-proceeding with stale bootsupport (-confirm 0 supplied)-"
} elseif {![::punkboot::lib::stdin_is_interactive]} {
puts stderr "-aborted- (minor-version bootsupport staleness and stdin is not interactive)"
puts stderr " Update bootsupport (recommended - see above), or rerun with -confirm 0 to proceed with stale bootsupport."
exit 1
} elseif {![::punkboot::lib::bootsupport_prompt_yesno "Minor-version staleness — backward-compat aliases should keep old bootsupport functional."]} {
puts stderr "-aborted- by user"
exit 1
} else {
puts stderr "-proceeding with stale bootsupport at user's request-"
}
}
# patch-only staleness: warn and proceed (warning already printed above)
}
set scriptfolder $::punkboot::scriptfolder
#first look for a project root (something under fossil or git revision control AND matches punk project folder structure)
#If that fails - just look for a 'project shaped folder' ie meets minimum requirements of /src /src/lib /src/modules /lib /modules
#test
if {[catch {punk::repo::find_project}]} {
puts stderr "punk::repo [package provide punk::repo]"
}
if {![string length [set projectroot [punk::repo::find_project $scriptfolder]]]} {
if {![string length [set projectroot [punk::repo::find_candidate $scriptfolder]]]} {
puts stderr "punkboot script unable to determine an approprite project root at or above the path '$scriptfolder' ensure the make script is within a project folder structure"
puts stderr " -aborted- "
exit 2
#todo?
#ask user for a project name and create basic structure?
#call punk::mix::cli::new $projectname on parent folder?
} else {
puts stderr "WARNING punkboot script operating in project space that is not under version control"
}
} else {
}
set sourcefolder $projectroot/src
set binfolder $projectroot/bin
# ----------------------------------------
# G-121 selective bake: resolve requested kit names against the parsed kit-mapping
# model before ANY build machinery runs - an unknown name must error without building,
# and a selected-but-unbuildable kit (missing runtime/vfs) fails fast rather than
# silently doing nothing (bare 'bake' keeps the historical warn-and-continue
# behaviour for the full configured set). The kit machinery and the vfslibs phase
# consult the bake_selected_* results to confine processing (and punkcheck events)
# to the requested kits.
set ::punkboot::bake_selected_kitnames [list] ;#empty = all configured (bare bake/bakehouse/bin)
set ::punkboot::bake_selected_targetkits [list] ;#platform artifact names (e.g punk91.exe)
set ::punkboot::bake_selected_vfs [list] ;#vfs folder tails the selected kits use
set ::punkboot::bake_selected_runtimes [list] ;#unsuffixed runtime names the selected kits wrap
if {$::punkboot::command eq "bake" && [llength $::punkboot::opt_kitnames]} {
set _rtbase $binfolder/runtime
set _mapmodel [punkboot::lib::mapvfs_parse $sourcefolder/runtime/mapvfs.config $_rtbase $sourcefolder $::punkboot::target_platform]
if {[llength [dict get $_mapmodel configerrors]]} {
foreach _errline [dict get $_mapmodel configerrors] {
puts stderr $_errline
}
exit 3
}
set _kit_outputs [punkboot::lib::mapvfs_kit_outputs $_mapmodel $_rtbase $sourcefolder]
set _matchinfo [punkboot::lib::mapvfs_match_outputs $_kit_outputs $::punkboot::opt_kitnames]
if {[llength [dict get $_matchinfo unknown]]} {
puts stderr "make.tcl bake: unknown kit name(s): [join [dict get $_matchinfo unknown] {, }] - nothing built"
if {[llength $_kit_outputs]} {
puts stderr " configured kit outputs: [join [lmap _r $_kit_outputs {dict get $_r kitname}] {, }]"
} else {
puts stderr " no kit outputs are configured (src/runtime/mapvfs.config)"
}
foreach _n [dict get $_matchinfo unknown] {
if {[string match -* $_n]} {
puts stderr " note: flags go before kit names, e.g 'make.tcl bake -confirm 0 punk91'"
break
}
}
puts stderr " ('make.tcl bakelist' shows the configured kit matrix)"
exit 1
}
foreach _rec [dict get $_matchinfo selected] {
if {![dict get $_rec vfs_present]} {
puts stderr "make.tcl bake: kit '[dict get $_rec kitname]' cannot be built - vfs folder src/vfs/[dict get $_rec vfs] is missing - nothing built"
exit 1
}
if {[dict get $_rec runtime] ne "-" && ![dict get $_rec runtime_present]} {
puts stderr "make.tcl bake: kit '[dict get $_rec kitname]' cannot be built - runtime [dict get $_rec runtime_file] not present in bin/runtime/[dict get $_rec store_tier] (target [dict get $_rec target]) - nothing built"
exit 1
}
}
foreach _rec [dict get $_matchinfo selected] {
lappend ::punkboot::bake_selected_kitnames [dict get $_rec kitname]
lappend ::punkboot::bake_selected_targetkits [dict get $_rec targetkit]
if {[dict get $_rec vfs] ni $::punkboot::bake_selected_vfs} {
lappend ::punkboot::bake_selected_vfs [dict get $_rec vfs]
}
if {[dict get $_rec runtime] ni $::punkboot::bake_selected_runtimes} {
lappend ::punkboot::bake_selected_runtimes [dict get $_rec runtime]
}
}
puts stdout "selective bake (G-121): [join $::punkboot::bake_selected_kitnames {, }]"
unset -nocomplain _rtbase _mapmodel _kit_outputs _matchinfo _rec _r _errline
}
# ----------------------------------------
# Provenance-warning presentation + dirty-src check for build/promotion commands (goal G-026 direction).
# Build/promotion commands stamp versions onto src content and propagate it into trees other
# things consume (root modules/, bootsupport snapshots, vfs payloads, kits/zipkits).
# Artifacts built from uncommitted src have no committed provenance - warn by default,
# abort if the -dirty-abort flag was given. To evaluate uncommitted source without
# building, use '<builtexe> src' / '<builtexe> src shell' instead.
# Guarded require: a stale or missing punkboot::utils bootsupport snapshot must never
# brick the make.tcl commands used to repair it - the check degrades to a skip notice
# (but -dirty-abort still aborts rather than silently skipping the requested strictness).
#Emit provenance warnings with a plain column-0 token for automated discovery (grep PROVENANCE-WARNING
#in redirected output) and ANSI colour for humans. Lines are also accumulated in
#::punkboot::provenance_warnings_pending unless -norecap is given, so the wrapped ::exit below can
#recap them at the tail of the output - build progress output is chatty and the original warning
#position may scroll out of sight or even out of scrollback.
set ::punkboot::provenance_warnings_pending [list]
proc ::punkboot::print_provenance_warnings {warninglines args} {
global A
if {![array size A]} {punkboot::define_global_ansi}
foreach w $warninglines {
regsub {^WARNING: } $w "" w
puts stderr "PROVENANCE-WARNING: $A(BAD)$w$A(RST)"
if {"-norecap" ni $args} {
lappend ::punkboot::provenance_warnings_pending $w
}
}
flush stderr
}
#General build warnings that must stay noticeable despite chatty build output - same
#column-0 greppable-token + recap-at-exit treatment as provenance warnings above.
set ::punkboot::build_warnings_pending [list]
proc ::punkboot::print_build_warnings {warninglines args} {
global A
if {![array size A]} {punkboot::define_global_ansi}
foreach w $warninglines {
regsub {^WARNING: } $w "" w
puts stderr "BUILD-WARNING: $A(BAD)$w$A(RST)"
if {"-norecap" ni $args} {
lappend ::punkboot::build_warnings_pending $w
}
}
flush stderr
}
#Availability probe + scoped dirty-src check, shared by the build/promotion gate below and the
#'check' command report. Returns {available warninglist}.
proc ::punkboot::get_src_provenance_warnings {projectroot label} {
set available [expr {\
![catch {package require punkboot::utils}]\
&& [llength [info commands ::punkboot::utils::vcs_dirty_warnings]]\
&& "scope" in [info args ::punkboot::utils::vcs_dirty_warnings]\
}]
if {!$available} {
return [list 0 [list]]
}
set checked_vcs_roots [dict create]
return [list 1 [::punkboot::utils::vcs_dirty_warnings $projectroot checked_vcs_roots $label src]]
}
#Replace a file that may be MEMORY-MAPPED by another process (or by this one).
#
#On windows an ordinary 'file copy -force' onto a mapped file is refused: a zipfs mount
#maps its archive (tclZipfs.c CreateFileMappingW + MapViewOfFile), so a zip-based .tm
#modpod that any running shell - including this build - has mounted cannot be overwritten
#in place. Windows reports ERROR_USER_MAPPED_FILE (1224); Tcl's Tcl_WinConvertError maps
#only Win32 codes 0..267 and sends everything above them to EINVAL, so it surfaces as the
#uninformative "invalid argument" (same code in 8.6 and 9.x).
#
#UNLINKING a mapped file IS allowed - the holder keeps reading its own mapping and new
#content lands at the name - so delete-then-place succeeds where overwrite cannot. The new
#content goes to a sibling temp FIRST so a mid-sequence failure can never leave the target
#missing.
#
#Returns one of: ok (plain copy worked), replaced (needed the delete-then-place path),
#failed (target untouched), broken (target was unlinked and could not be restored - the
#caller must treat this as serious). The first copy's error message is written to the
#variable named by firsterrvar.
proc ::punkboot::replace_possibly_mapped_file {srcfile tgtfile firsterrvar} {
upvar 1 $firsterrvar firsterr
set firsterr ""
if {![catch {file copy -force $srcfile $tgtfile} firsterr]} {
return ok
}
if {![file exists $tgtfile]} {
#nothing to unlink - whatever failed, it was not an in-place overwrite
return failed
}
set tmpfile $tgtfile.punkboot-new
catch {file delete -force -- $tmpfile}
if {[catch {file copy -- $srcfile $tmpfile}]} {
catch {file delete -force -- $tmpfile}
return failed
}
if {[catch {file delete -- $tgtfile}]} {
catch {file delete -force -- $tmpfile}
return failed
}
if {[catch {file rename -- $tmpfile $tgtfile}]} {
return broken
}
return replaced
}
#Actionable text for a file-operation failure whose message is windows' catch-all.
#Returns "" when the error does not look like that case.
proc ::punkboot::mapped_file_hint {errmsg tgtfile} {
if {![string match -nocase "*invalid argument*" $errmsg]} {
return ""
}
return "'invalid argument' is Tcl's catch-all for any windows error above 267 (Tcl_WinConvertError), not a bad argument.\
For a file replace the usual cause is ERROR_USER_MAPPED_FILE: '$tgtfile' is memory-mapped by a process that has it mounted -\
a zipfs/modpod mount does this, so a running punk shell (or this build) holding that .tm blocks an in-place overwrite.\
Close shells holding it, or rerun - the update now replaces such files by delete-then-place rather than overwrite."
}
#Availability probe + boot-precondition check of an assembled kit vfs (G-125), shared by the
#kit gate in the bake loop and the 'check' command report. Same guarded-require treatment as
#the provenance check above: a stale or missing punkboot::utils snapshot must not brick the
#commands used to repair it, so an unavailable check degrades to a notice rather than failing
#every kit. Returns {available report}.
proc ::punkboot::get_vfs_boot_library_report {vfsfolder} {
set available [expr {\
![catch {package require punkboot::utils}]\
&& [llength [info commands ::punkboot::utils::vfs_boot_library_report]]\
}]
if {!$available} {
return [list 0 [dict create]]
}
return [list 1 [::punkboot::utils::vfs_boot_library_report $vfsfolder]]
}
#Availability probe + advisory payload/target binary-arch scan of an assembled kit vfs
#(G-133), shared by the bake loop and the 'check' command report. Same guarded-require
#treatment as the boot-precondition check above: a stale bootsupport snapshot degrades
#the scan to a NOTE. Returns {available report}.
proc ::punkboot::get_vfs_binary_arch_report {vfsfolder targetplatform} {
set available [expr {\
![catch {package require punkboot::utils}]\
&& [llength [info commands ::punkboot::utils::vfs_binary_arch_report]]\
}]
if {!$available} {
return [list 0 [dict create]]
}
return [list 1 [::punkboot::utils::vfs_binary_arch_report $vfsfolder $targetplatform]]
}
#G-133 smoke-require probe: execute a freshly built kit artifact via its 'tclsh'
#subcommand and plain-'package require' each declared package inside it. This is the
#only check that observes actual package RESOLUTION in the artifact - the punkluck86
#incident class (a higher-versioned wrong-arch Thread shadowing the runtime's working
#copy on plain require) is invisible to every structural check because the working
#file exists. The tclsh subcommand is used deliberately: it exits cleanly even on
#runtimes whose full repl teardown is fragile, and a script argument with drained
#stdin cannot reach any console-reopen path. ADVISORY: failures become recapped
#BUILD-WARNINGs naming kit, package and the actual error - the kit still deploys.
#Returns 1 when every declared package resolved, else 0.
proc ::punkboot::kit_smoke_require_probe {kitpath targetkit packages} {
set probescript [file rootname $kitpath]_smokerequire.tcl
if {[catch {
set fd [open $probescript w]
chan configure $fd -translation lf
puts $fd "#generated by make.tcl bake (G-133) - smoke-require probe for $targetkit"
puts $fd "set packages [list $packages]"
puts $fd {foreach pkg $packages {
if {[catch {package require $pkg} v]} {
puts stdout [list SMOKE-REQUIRE $pkg FAIL $v]
} else {
puts stdout [list SMOKE-REQUIRE $pkg OK $v]
}
}
exit 0}
close $fd
} errM]} {
catch {close $fd}
::punkboot::print_build_warnings [list "smoke-require for kit $targetkit could not write its probe script ($probescript): $errM"]
return 0
}
if {[catch {
lassign [punk::lib::invoke [list [file nativename $kitpath] tclsh [file nativename $probescript] << ""]] p_stdout p_stderr p_exitcode
} errM]} {
::punkboot::print_build_warnings [list "smoke-require FAILED for kit $targetkit: could not execute freshly built artifact via its tclsh subcommand ($errM)"]
return 0
}
set seen [dict create]
foreach line [split $p_stdout \n] {
set line [string trim $line]
if {![string match "SMOKE-REQUIRE *" $line]} {
continue
}
#each line is a well-formed tcl list: SMOKE-REQUIRE <pkg> OK|FAIL <version|error>
if {[catch {lassign $line - r_pkg r_status r_detail}]} {
continue
}
dict set seen $r_pkg [list $r_status $r_detail]
}
set allok 1
set warnings [list]
foreach pkg $packages {
if {![dict exists $seen $pkg]} {
set allok 0
set tail [string trim [join [lrange [split [string trim $p_stderr] \n] end-2 end] " | "]]
lappend warnings "smoke-require FAILED for kit $targetkit: no result for package '$pkg' (artifact exited $p_exitcode before reporting[expr {$tail ne "" ? "; stderr tail: $tail" : ""}])"
continue
}
lassign [dict get $seen $pkg] r_status r_detail
if {$r_status eq "OK"} {
puts stdout " smoke-require OK for kit $targetkit: package require $pkg -> $r_detail"
} else {
set allok 0
lappend warnings "smoke-require FAILED for kit $targetkit: package require $pkg -> $r_detail"
}
}
if {$p_exitcode != 0} {
set allok 0
lappend warnings "smoke-require for kit $targetkit: artifact exited with code $p_exitcode via its tclsh subcommand (expected 0)"
}
if {[llength $warnings]} {
::punkboot::print_build_warnings $warnings
}
return $allok
}
#Wrap ::exit so accumulated provenance warnings are recapped at the very end of output no matter
#which of make.tcl's many exit points a command takes.
if {![llength [info commands ::punkboot::exit_original]]} {
rename ::exit ::punkboot::exit_original
proc ::exit {{returnCode 0}} {
if {[info exists ::punkboot::provenance_warnings_pending] && [llength $::punkboot::provenance_warnings_pending]} {
puts stderr ""
puts stderr "PROVENANCE-WARNING: recap of warning(s) emitted earlier in this run:"
::punkboot::print_provenance_warnings $::punkboot::provenance_warnings_pending -norecap
}
if {[info exists ::punkboot::build_warnings_pending] && [llength $::punkboot::build_warnings_pending]} {
puts stderr ""
puts stderr "BUILD-WARNING: recap of warning(s) emitted earlier in this run:"
::punkboot::print_build_warnings $::punkboot::build_warnings_pending -norecap
}
::punkboot::exit_original $returnCode
}
}
if {$::punkboot::command in {bakehouse packages modules libs bake vfslibs bin bootsupport vfscommonupdate}} {
set dirty_abort $::punkboot::opt_dirty_abort
lassign [::punkboot::get_src_provenance_warnings $projectroot "make.tcl $::punkboot::command"] have_scoped_dirty_check dirty_warnings
if {$have_scoped_dirty_check} {
if {[llength $dirty_warnings]} {
::punkboot::print_provenance_warnings $dirty_warnings
puts stderr " To evaluate uncommitted source without building, use '<builtexe> src' or '<builtexe> src shell'."
if {$dirty_abort} {
set ::punkboot::provenance_warnings_pending [list] ;#no recap needed - aborting adjacent to the warning
if {$::punkboot::command eq "bakehouse"} {
puts stderr "-aborted- bakehouse refuses to bake from uncommitted src (the bakehouse bakes from the committed recipe)."
puts stderr " Developer flow for uncommitted changes:"
puts stderr " make.tcl packages -> test ('<builtexe> src', src/tests/runtests.tcl)"
puts stderr " make.tcl bootsupport + make.tcl vfscommonupdate (promotion gates)"
puts stderr " commit -> make.tcl bake"
puts stderr " To build anyway without committed provenance: make.tcl bakehouse -dirty-abort 0"
} else {
puts stderr "-aborted- (-dirty-abort given and src has uncommitted changes - commit first, or rerun without -dirty-abort to build with a warning)"
}
exit 1
}
#Grace period for an attentive human to ctrl-c - only when stdin is a terminal
#(-inputmode is only supported on terminal channels, Tcl 8.7+/9; pipes/redirects/8.6 skip the delay
# so agent/CI runs pay nothing)
if {![catch {chan configure stdin -inputmode}]} {
puts -nonewline stderr " proceeding despite dirty src - ctrl-c now to abort "
flush stderr
foreach tick {3 2 1} {
puts -nonewline stderr "..$tick"
flush stderr
after 1000
}
puts stderr ""
}
}
} else {
if {$dirty_abort} {
puts stderr "-aborted- (-dirty-abort given but the dirty-src provenance check is unavailable: punkboot::utils vcs_dirty_warnings with scope support not loadable from bootsupport)"
exit 1
}
puts stderr "NOTE: dirty-src provenance check unavailable (punkboot::utils vcs_dirty_warnings with scope support not loadable from bootsupport) - continuing without it"
}
}
if {$::punkboot::command eq "check"} {
set sep [string repeat - 75]
puts stdout $sep
puts stdout "colour policy (G-113): mode=$::punkboot::colour_mode colour_disabled=$::punk::console::colour_disabled ansistrip=[expr {[llength $::punkboot::ansistrip_pushed] ? [join $::punkboot::ansistrip_pushed +] : 0}]"
puts stdout " (precedence: NO_COLOR > PUNK_FORCE_COLOR/FORCE_COLOR > stdout tty probe incl. the 8.6 windows console-encoding signature; piped/unknown output is fully ESC-stripped per channel unless forced - utf-16 console channels are never wrapped)"
puts stdout $sep
#G-122 host/target platform split - the self-diagnosis for "why is my kit set
#addressed the way it is". One stable single line; the columns are key=value.
set _chk_suffix [punkboot::lib::platform_exe_suffix $::punkboot::target_platform]
if {$_chk_suffix eq ""} {set _chk_suffix "(none)"}
puts stdout "platform (G-122): host=$::punkboot::host_platform target=$::punkboot::target_platform store=bin/runtime/[punkboot::lib::platform_store_tier $::punkboot::target_platform] exe-suffix=$_chk_suffix process-tooling=[punkboot::lib::platform_process_family $::punkboot::target_platform]"
puts stdout " (host = this tclsh's punk::platform canon, from tcl_platform(os)='$::tcl_platform(os)' platform='$::tcl_platform(platform)'; target = default kit target - a cygwin-family host (msys2/cygwin runtime on windows) bakes win32 kits)"
puts stdout " (mapvfs.config entries may declare their own target platform as a 4th element - 'make.tcl bakelist' shows each kit's target, store tier and artifact name)"
unset -nocomplain _chk_suffix
puts stdout $sep
puts stdout "module/library checks - paths from bootsupport only"
puts stdout $sep
puts stdout "- tcl::tm::list"
foreach fld [tcl::tm::list] {
if {[file exists $fld]} {
puts stdout " $fld"
} else {
puts stdout " $fld (not present)"
}
}
puts stdout "- auto_path"
foreach fld $::auto_path {
if {[file exists $fld]} {
puts stdout " $fld"
} else {
puts stdout " $fld (not present)"
}
}
flush stdout
set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements]
foreach pkg_request [dict get $::punkboot::pkg_availability loaded] {
lassign $pkg_request pkgname vrequest
package require $pkgname {*}$vrequest ;#todo?
}
flush stderr
#punk::lib::showdict -channel stderr $::punkboot::pkg_availability
set missing_out [::punkboot::get_display_missing_packages $::punkboot::pkg_availability]
puts stdout $missing_out\n
set broken_out [::punkboot::get_display_broken_packages $::punkboot::pkg_availability]
puts stdout $broken_out
set v [package require punk::mix::base]
#don't exit yet - 2nd part of "check" below package path restore
}
# -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
# - package path restore original module paths and auto_path entries to take effect in addition to bootsupport paths
# - Order such that bootsupport entries are always higher priority (if same version number - prefer bootsupport)
# - This must be done between the two "check" command sections
# Ideally we would be running make.tcl purely from bootsupport packages - but binary packages such as Thread are required,
# and without accelerators the performance is abysmal (e.g minutes vs seconds for common sha1 operations)
if {$package_paths_modified} {
set tm_list_boot [tcl::tm::list]
tcl::tm::remove {*}$tm_list_boot
set lower_prio [list]
foreach p $original_tm_list {
if {$p ni $tm_list_boot} {
lappend lower_prio $p
}
}
tcl::tm::add {*}[lreverse $lower_prio] {*}[lreverse $tm_list_boot]
#set ::auto_path [list $bootsupport_lib {*}$original_auto_path]
lappend ::auto_path {*}$original_auto_path
}
# -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
# -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
#The problem with forcing our main packages to load only from bootsupport/sourcesupport is that if they require packages that use accelerators
# and no acceleration is available in bootsupport/sourcesupport - then they will stay unaccelerated even if the os packages provide it
# Also - some packages such as struct::set don't seem to handle reloading after forget (at least - not without destroying the command first)
#Packages that provide acceleration don't use a consistent API for testing acceleration e.g md5, sha1, struct::set in tcllib all differ in
#whether they provide functions such as Loaded, Implementations, SwitchTo
set acceleratable [list sha1 md5]
lappend acceleratable {*}[lsearch -all -inline [package names] struct::*]
set acceleratable_reload [list]
foreach p $acceleratable {
if {[package provide $p] ne ""} {
#was actually loaded (not merely indexed) - must be re-required below or consumers
#that already required it are left calling a destroyed/forgotten command
lappend acceleratable_reload $p
}
package forget $p
if {[string match struct::* $p]} {
catch {rename $p ""}
}
}
#Re-require whatever was loaded before the forget. The forget/rename exists so the reload can
#pick up accelerators (e.g tcllibc) from the now-restored full package paths - but the reload
#must actually happen here: when make.tcl runs under a built punk executable the consumers
#(punk::lib, punk::du, flagfilter etc) were already loaded at kit boot, so no later
#'package require' chain re-fires for these and e.g raw-mode repl paths would hit
#'invalid command name struct::set'. (Under plain tclsh the shell-branch loads happened to
#re-require them - relying on that was load-order luck, not design.)
foreach p $acceleratable_reload {
if {[catch {package require $p} _accelerr]} {
puts stderr "make.tcl: failed to reload package $p after accelerator-reload forget ($_accelerr) - its commands are unavailable for the rest of this run"
}
}
unset -nocomplain acceleratable_reload _accelerr
# -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
#2nd part of "check"
if {$::punkboot::command eq "check"} {
set sep [string repeat - 75]
puts stdout $sep
puts stdout "module/library checks - paths from bootsupport plus those provided by running interp [info nameofexecutable]"
puts stdout $sep
puts stdout "- tcl::tm::list"
foreach fld [tcl::tm::list] {
if {[file exists $fld]} {
puts stdout " $fld"
} else {
#puts stdout " $fld (not present)"
}
}
puts stdout "- auto_path"
foreach fld $::auto_path {
if {[file exists $fld]} {
puts stdout " $fld"
} else {
#puts stdout " $fld (not present)"
}
}
set ::punkboot::pkg_availability [::punkboot::check_package_availability -quiet 1 $::punkboot::bootsupport_requirements]
foreach pkg_request [dict get $::punkboot::pkg_availability loaded] {
lassign $pkg_request pkgname vrequest
if {[catch {package require $pkgname {*}$vrequest} errM]} {
puts stderr "failed to load $pkgname\n - $errM\n - $::errorInfo"
}
}
flush stderr
#punk::lib::showdict -channel stderr $::punkboot::pkg_availability
set missing_out [::punkboot::get_display_missing_packages $::punkboot::pkg_availability]
puts stdout $missing_out\n
set broken_out [::punkboot::get_display_broken_packages $::punkboot::pkg_availability]
puts stdout $broken_out
puts stdout $sep
puts stdout $sep
catch {package require struct::set}
puts stdout ---[package ifneeded struct::set 2.2.3]
# Show bootsupport staleness warning at the end of check output
if {[info exists ::punkboot::stale_bootsupport]} {
puts stderr "=============================================================================="
puts stderr "WARNING: bootsupport modules are stale relative to source modules:"
foreach _entry $::punkboot::stale_bootsupport {
lassign $_entry _pkg _src_ver _bs_ver _bump
puts stderr [format " %-15s bootsupport=%-10s source=%-10s bump=%s" $_pkg $_bs_ver $_src_ver $_bump]
}
puts stderr ""
puts stderr " Run the following to update bootsupport before proceeding:"
puts stderr " cd \[projectroot\]/src && tclsh make.tcl modules && tclsh make.tcl bootsupport"
puts stderr "=============================================================================="
}
# Dirty-src provenance status - what the build/promotion commands would do
puts stdout $sep
lassign [::punkboot::get_src_provenance_warnings $projectroot "make.tcl check"] _prov_available _prov_warnings
if {!$_prov_available} {
puts stdout "src provenance: check unavailable (punkboot::utils vcs_dirty_warnings with scope support not loadable from bootsupport)"
puts stdout " build/promotion commands will proceed with a NOTE; -dirty-abort would abort as unverifiable."
} elseif {![llength $_prov_warnings]} {
puts stdout "src provenance: OK (no uncommitted fossil/git changes under src/)"
puts stdout " build/promotion commands (project packages modules libs vfs vfslibs bin bootsupport vfscommonupdate) will proceed without provenance warnings."
} else {
::punkboot::print_provenance_warnings $_prov_warnings -norecap
puts stdout " build/promotion commands (project packages modules libs vfs vfslibs bin bootsupport vfscommonupdate) will WARN as above and proceed."
puts stdout " With -dirty-abort they would abort. To evaluate uncommitted source without building, use '<builtexe> src' or '<builtexe> src shell'."
}
# Kit boot-precondition gate status - whether a bake can refuse an unbootable kit
puts stdout $sep
#availability probe only - the path deliberately does not exist
lassign [::punkboot::get_vfs_boot_library_report [file join $projectroot __punkboot_bootgate_probe__]] _boot_available _boot_report
if {$_boot_available} {
puts stdout "boot-precondition gate (G-125): ACTIVE"
puts stdout " bake checks each kit's merged vfs for a tcl library (tcl_library/, lib/tcl<major>.<minor>/ or"
puts stdout " tcl<major>.<minor>/) before building it. A kit with none is reported under FAILED KITS and is"
puts stdout " neither built nor deployed, so a previously deployed kit is never replaced by an artifact that"
puts stdout " cannot initialise."
} else {
puts stdout "boot-precondition gate (G-125): UNAVAILABLE (punkboot::utils vfs_boot_library_report not loadable from bootsupport)"
puts stdout " bake will proceed with a NOTE and cannot refuse an unbootable kit - run 'make.tcl modules' then 'make.tcl bootsupport'."
}
# Payload/target consistency checks (G-133) - advisory arch scan + smoke-require probe
puts stdout $sep
#availability probe only - the path deliberately does not exist
lassign [::punkboot::get_vfs_binary_arch_report [file join $projectroot __punkboot_archscan_probe__] $::punkboot::target_platform] _arch_available _arch_report
if {$_arch_available} {
puts stdout "payload/target arch scan (G-133): ACTIVE (advisory)"
puts stdout " bake classifies each merged kit's binary libraries (*.dll/*.so/*.dylib header bytes - structural,"
puts stdout " nothing executed, cross-target kits included) against the kit's target platform and emits"
puts stdout " recapped BUILD-WARNINGs for wrong-arch libraries outside platform-discriminated subdirs"
puts stdout " (canonical <os>-<cpu> names and recognised vendor spellings such as win-x64 are exempt)."
} else {
puts stdout "payload/target arch scan (G-133): UNAVAILABLE (punkboot::utils vfs_binary_arch_report not loadable from bootsupport)"
puts stdout " bake will proceed with a NOTE and cannot flag wrong-arch payload libraries - run 'make.tcl modules' then 'make.tcl bootsupport'."
}
set _smoke_declared [list]
if {[file exists $sourcefolder/runtime/mapvfs.config]} {
set _smokemodel [punkboot::lib::mapvfs_parse $sourcefolder/runtime/mapvfs.config [file dirname $sourcefolder]/bin/runtime $sourcefolder $::punkboot::target_platform]
foreach _rec [punkboot::lib::mapvfs_kit_outputs $_smokemodel [file dirname $sourcefolder]/bin/runtime $sourcefolder] {
if {[llength [dict get $_rec smokerequire]]} {
lappend _smoke_declared "[dict get $_rec kitname] ([join [dict get $_rec smokerequire] {, }])"
}
}
unset -nocomplain _smokemodel _rec
}
puts stdout "smoke-require probe (G-133, advisory): freshly built host-runnable kits declaring packages"
puts stdout " (mapvfs.config 5th entry element) have each one plain-'package require'd inside the built"
puts stdout " artifact via its tclsh subcommand - the only check that sees resolution-order defects such as"
puts stdout " a wrong-arch higher-versioned package shadowing a working copy. Failures are recapped"
puts stdout " BUILD-WARNINGs; cross-target kits skip with a stated reason; undeclared kits run nothing new."
if {[llength $_smoke_declared]} {
puts stdout " declared: [join $_smoke_declared {; }]"
} else {
puts stdout " declared: (none)"
}
puts stdout $sep
exit 0
}
if {![array size A]} {
punkboot::define_global_ansi
}
#puts stderr ">>>>>>+ loaded:[info loaded]"
#puts stderr "llength package names: [llength [package names]]"
if {[info exists ::punk::libunknown::epoch]} {
set untracked [dict get $::punk::libunknown::epoch pkg untracked]
#puts stderr "punk::libunknown::epoch exists"
} else {
set untracked [list]
#puts stderr "punk::libunknown::epoch does not exist"
}
#REVIEW - we shouldn't need to manually set the untracked packages - punk::libunknown::init should have done it?
foreach p [package names] {
if {![dict exists $untracked $p]} {
dict set untracked $p ""
}
}
dict set ::punk::libunknown::epoch pkg untracked $untracked
if {[package provide punk::libunknown] eq ""} {
puts "punk::libunknown not loaded"
} else {
puts "punk::libunknown loaded"
}
dict for {pkg pkginfo} $::punkboot::bootsupport_requirements {
set verspec [dict get $pkginfo version] ;#version wanted specification always exists and is empty or normalised
if {[catch {package require $pkg {*}$verspec} errM]} {
puts stdout "$A(BAD)$errM$A(RST)"
}
}
if {$::punkboot::command eq "info"} {
puts stdout "- -- --- --- --- --- --- --- --- --- -- -"
puts stdout "- -- info -- -"
puts stdout "- -- --- --- --- --- --- --- --- --- -- -"
puts stdout "- projectroot : $projectroot"
set sourcefolder $projectroot/src
#todo show all but highlight the one that matches $this_platform_generic
set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*]
puts stdout "- vendorlib folders: ([llength $vendorlibfolders])"
foreach fld $vendorlibfolders {
puts stdout " src/$fld"
}
set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*]
puts stdout "- vendormodule folders: ([llength $vendormodulefolders])"
foreach fld $vendormodulefolders {
puts stdout " src/$fld"
}
#set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] ;#returns only those containing .tm files
#foreach fld $source_module_folderlist {
# set relpath [punkcheck::lib::path_relative $projectroot $fld]
# puts stdout " $relpath"
#}
set projectmodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails modules_tcl* modules]
puts stdout "- source module paths: [llength $projectmodulefolders]"
#JJJ
foreach fld $projectmodulefolders {
puts stdout " $fld"
}
set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl* lib]
puts stdout "- source libary paths: [llength $projectlibfolders]"
foreach fld $projectlibfolders {
puts stdout " src/$fld"
}
if {[punk::repo::find_fossil $scriptfolder] eq $projectroot} {
set vc "fossil"
set rev [punk::repo::fossil_revision $scriptfolder]
set rem [punk::repo::fossil_remote $scriptfolder]
} elseif {[punk::repo::find_git $scriptfolder] eq $projectroot} {
set vc "git"
set rev [punk::repo::git_revision $scriptfolder]
set rem [punk::repo::git_remote $scriptfolder]
} else {
set vc " - none found -"
set rev "n/a"
set remotes "n/a"
}
puts stdout "- version control : $vc"
puts stdout "- revision : $rev"
puts stdout "- remote"
foreach ln [split $rem \n] {
puts stdout " $ln"
}
puts stdout "- -- --- --- --- --- --- --- --- --- -- -"
exit 0
}
if {$::punkboot::command eq "projectversion"} {
package require punkboot::utils
set sep [string repeat - 75]
puts stdout $sep
puts stdout "project version check"
puts stdout $sep
set pp_file [file join $projectroot punkproject.toml]
set cl_file [file join $projectroot CHANGELOG.md]
set src_folder [file join $projectroot src]
set pp_version [::punkboot::utils::read_punkproject_version $pp_file]
set cl_version [::punkboot::utils::read_changelog_latest_version $cl_file]
puts stdout "punkproject.toml version : [expr {[string length $pp_version] ? $pp_version : "(not found)"}]"
puts stdout "CHANGELOG.md version : [expr {[string length $cl_version] ? $cl_version : "(not found)"}]"
# 1. Consistency: CHANGELOG latest header must match punkproject.toml version.
if {![string length $pp_version]} {
puts stderr "WARNING: could not read version from $pp_file"
} elseif {![string length $cl_version]} {
puts stderr "WARNING: no '## \[X.Y.Z\]' version header found in $cl_file"
} elseif {$pp_version ne $cl_version} {
puts stderr "WARNING: version mismatch — punkproject.toml=$pp_version but CHANGELOG.md=$cl_version"
puts stderr " The latest '## \[X.Y.Z\]' header in CHANGELOG.md must match the version in punkproject.toml."
} else {
puts stdout "consistency: OK (versions match)"
}
# 2. Staleness: warn if src/ has git commits since the last commit
# touching punkproject.toml (version bump may be overdue).
# If punkproject.toml has an uncommitted version change, the bump is
# already in progress — report that only a commit is needed.
# Best-effort — silently skipped if git is unavailable or the repo
# is not under git revision control.
set pp_commit ""
if {![catch {exec git -C $projectroot log -1 --format=%H -- punkproject.toml} pp_raw]} {
set pp_commit [string trim $pp_raw]
}
if {[string length $pp_commit]} {
if {![catch {exec git -C $projectroot log --oneline ${pp_commit}..HEAD -- src/} src_raw]} {
set src_changes [string trim $src_raw]
if {[string length $src_changes]} {
set n [llength [split $src_changes \n]]
# Check whether a bump is already staged in the working tree
# (punkproject.toml modified but uncommitted). If the working-
# tree version differs from HEAD, the bump is done — only a
# commit is needed.
set head_version ""
if {![catch {exec git -C $projectroot show HEAD:punkproject.toml} head_raw]} {
set head_version [::punkboot::utils::parse_punkproject_version $head_raw]
}
set bump_uncommitted [expr {[string length $head_version] && [string length $pp_version] && $pp_version ne $head_version}]
if {$bump_uncommitted} {
puts stderr "NOTE: $n commit(s) in src/ since last punkproject.toml commit, but punkproject.toml already bumped ($head_version -> $pp_version, uncommitted)."
puts stderr " Commit punkproject.toml (and CHANGELOG.md) to record the bump and clear this warning."
} else {
puts stderr "WARNING: $n commit(s) in src/ since last punkproject.toml change — a project-version bump may be overdue."
puts stderr " Review the changes and bump punkproject.toml per the root AGENTS.md 'Project Versioning' section."
}
puts stderr " (showing first 5 commits below)"
set i 0
foreach line [split $src_changes \n] {
if {$i >= 5} break
puts stderr " $line"
incr i
}
} else {
puts stdout "staleness: OK (no src/ changes since last punkproject.toml commit)"
}
} else {
puts stdout "staleness: skipped (git query failed)"
}
} else {
puts stdout "staleness: skipped (punkproject.toml has no git history or git unavailable)"
}
puts stdout $sep
exit 0
}
if {$::punkboot::command eq "workflow"} {
puts stdout [::punkboot::workflow_text]
exit 0
}
if {$::punkboot::command eq "bakelist"} {
#G-121: report the kit outputs configured in src/runtime/mapvfs.config, consuming
#the same parsed mapping model as the bake kit machinery (::punkboot::lib::mapvfs_*).
#Reporting only - never builds. Data rows are single-line and column-stable for
#grepping; expected state sits in the columns, anomalies surface in a trailing
#sparse notes column (key=value tags). Kit name arguments filter the report and
#add a per-kit detail block (resolved paths/sizes/mtimes).
#G-122: store addressing is keyed by TARGET platform. The default target is
#this host's own platform (a cygwin-family host targets win32) and mapvfs
#entries may declare their own - so each row resolves its own tier under
#bin/runtime and the report names the tiers it consulted.
set rt_default_target $::punkboot::target_platform
set rt_os_arch [punkboot::lib::platform_store_tier $rt_default_target]
set rtbase $binfolder/runtime
set rtfolder $rtbase/$rt_os_arch
set buildfolder $sourcefolder/_build
set mapfile $sourcefolder/runtime/mapvfs.config
set mapmodel [punkboot::lib::mapvfs_parse $mapfile $rtbase $sourcefolder $rt_default_target]
foreach errline [dict get $mapmodel configerrors] {
puts stderr $errline
}
foreach badline [dict get $mapmodel badentries] {
puts stderr $badline
}
if {![dict get $mapmodel exists]} {
puts stdout "no kit mapping config at $mapfile - no kit outputs configured"
exit 0
}
set kit_outputs [punkboot::lib::mapvfs_kit_outputs $mapmodel $rtbase $sourcefolder]
if {![llength $kit_outputs]} {
puts stdout "no kit outputs configured in $mapfile"
exit 0
}
#Loud store-tier guard: a nonexistent store folder makes every row addressing it
#read runtime=missing for a reason that is not per-entry. Reported per tier
#actually referenced, since entries may target different platforms (G-122).
set report_tiers [list]
foreach rec $kit_outputs {
if {[dict get $rec runtime] eq "-"} {continue}
set t [dict get $rec store_tier]
if {$t ni $report_tiers} {lappend report_tiers $t}
}
set rt_store_missing [expr {![file isdirectory $rtfolder]}]
if {$rt_os_arch ni $report_tiers} {lappend report_tiers $rt_os_arch}
foreach t $report_tiers {
if {[file isdirectory $rtbase/$t]} {continue}
if {$t eq $rt_os_arch} {
puts stderr "WARNING: runtime store folder bin/runtime/$t does not exist - every configured runtime on the default target will read runtime=missing."
puts stderr " Default target '$rt_default_target' derives from THIS tclsh: tcl_platform(os)='$::tcl_platform(os)' tcl_platform(platform)='$::tcl_platform(platform)' -> host canon '$::punkboot::host_platform' -> target '$rt_default_target'."
puts stderr " Populate it with 'bin/punk-runtime.cmd' (or by hand), or declare a per-entry target platform in mapvfs.config for runtimes stored elsewhere."
} else {
puts stderr "WARNING: runtime store folder bin/runtime/$t does not exist - configured entries targeting $t will read runtime=missing."
}
}
set reportset $kit_outputs
if {[llength $::punkboot::opt_kitnames]} {
set matchinfo [punkboot::lib::mapvfs_match_outputs $kit_outputs $::punkboot::opt_kitnames]
if {[llength [dict get $matchinfo unknown]]} {
puts stderr "bakelist: unknown kit name(s): [join [dict get $matchinfo unknown] {, }]"
puts stderr " configured kit outputs: [join [lmap r $kit_outputs {dict get $r kitname}] {, }]"
exit 1
}
set reportset [dict get $matchinfo selected]
}
#assemble rows before printing so columns can be sized to content
set rows [list]
foreach rec $reportset {
set kitname [dict get $rec kitname]
set kit_type [dict get $rec kit_type]
set runtime [dict get $rec runtime]
set vfstail [dict get $rec vfs]
set deployed [punkboot::lib::kit_deploy_state $buildfolder $binfolder [dict get $rec targetkit]]
set notes [list]
if {$runtime ne "-" && ![dict get $rec runtime_present]} {
lappend notes runtime=missing
}
if {![dict get $rec vfs_present]} {
lappend notes vfs=missing
}
if {[dict get $rec target] ne $rt_default_target} {
#cross-target entry: its runtime, store tier and artifact naming follow
#its own platform, not this host's default
lappend notes target=[dict get $rec target]
}
if {$runtime ne "-" && [dict get $rec runtime_present]} {
set rtstale [punkboot::lib::runtime_materialization_check [dict get $rec runtime_dir] [dict get $rec runtime_file]]
if {[dict size $rtstale]} {
lappend notes rtrev=r[dict get $rtstale current_rev]<r[dict get $rtstale maxrev]
}
}
lappend rows [list $kitname $kit_type $runtime $vfstail $deployed [join $notes " "]]
}
set headings [list kit type runtime vfs deployed]
set widths [list]
foreach h $headings {
lappend widths [string length $h]
}
foreach row $rows {
set newwidths [list]
foreach w $widths cell [lrange $row 0 4] {
lappend newwidths [expr {max($w,[string length $cell])}]
}
set widths $newwidths
}
set rt_store_note [expr {$rt_store_missing ? " (FOLDER MISSING)" : ""}]
puts stdout "# mapvfs: src/runtime/mapvfs.config runtimes: bin/runtime/$rt_os_arch$rt_store_note deployed: bin/<kit> vs src/_build/<kit>"
set headline ""
foreach h $headings w $widths {
append headline [format "%-*s " $w $h]
}
puts stdout [string trimright $headline]
foreach row $rows {
set line ""
foreach cell [lrange $row 0 4] w $widths {
append line [format "%-*s " $w $cell]
}
append line [lindex $row 5]
puts stdout [string trimright $line]
}
if {[llength $::punkboot::opt_kitnames]} {
#name filtering doubles as per-kit detail (punk-runtime list precedent)
proc ::punkboot::lib::bakelist_file_detail {path} {
if {![file isfile $path]} {
return "(not present)"
}
return "([file size $path] bytes, [clock format [file mtime $path] -format {%Y-%m-%d %H:%M:%S}])"
}
foreach rec $reportset row $rows {
puts stdout ""
puts stdout "detail: [dict get $rec kitname]"
set runtime [dict get $rec runtime]
if {$runtime eq "-"} {
puts stdout " runtime: (none - unwrapped .kit output)"
} else {
puts stdout " runtime file: bin/runtime/[dict get $rec store_tier]/[dict get $rec runtime_file] [expr {[dict get $rec runtime_present] ? {(present)} : {(MISSING)}}]"
}
puts stdout " vfs folder: src/vfs/[dict get $rec vfs] [expr {[dict get $rec vfs_present] ? {(present)} : {(MISSING)}}]"
puts stdout " kit type: [dict get $rec kit_type]"
puts stdout " target: [dict get $rec target][expr {[dict get $rec target] eq $rt_default_target ? " (host default)" : " (declared in mapvfs.config)"}]"
puts stdout " build product: src/_build/[dict get $rec targetkit] [punkboot::lib::bakelist_file_detail $buildfolder/[dict get $rec targetkit]]"
puts stdout " deployed: bin/[dict get $rec targetkit] [punkboot::lib::bakelist_file_detail $binfolder/[dict get $rec targetkit]] state=[lindex $row 4]"
}
}
exit 0
}
if {$::punkboot::command eq "buildsuite"} {
#G-104: thin front for the buildsuites (zig runtime factory - arm's-length
#subsystem building Tcl runtimes from external sources). Discovery is a
#directory scan; description/info come from each suite's sources.config
#records (description/product/doc/zigpin - the same manifest the suite.tcl
#driver parses), so copied/retargeted trees are first-class with no edits
#here. Contract: src/buildsuites/README.md.
set bs_root [file join $sourcefolder buildsuites]
if {![info exists ::punkboot::bs_args]} {set ::punkboot::bs_args [list]}
set bsargs $::punkboot::bs_args
set bs_action [lindex $bsargs 0]
if {$bs_action eq ""} {set bs_action list}
#tolerant manifest reader (make.tcl side): a suite with a malformed or absent
#sources.config still lists - with the problem as its description - rather
#than breaking discovery of the others. suite.tcl's own parser stays strict.
proc ::punkboot::buildsuite_manifest {suitedir} {
set m [dict create description "" products [list] docs [list] zigpin "" sources [list] note ""]
set cfg [file join $suitedir sources.config]
if {![file exists $cfg]} {
dict set m note "(no sources.config manifest)"
return $m
}
if {[catch {
set f [open $cfg r]; set data [read $f]; close $f
foreach line [split $data \n] {
set line [string trim $line]
if {$line eq "" || [string index $line 0] eq "#"} {continue}
if {[catch {llength $line}]} {continue}
switch -- [lindex $line 0] {
source {dict lappend m sources [lrange $line 1 end]}
description {dict set m description [join [lrange $line 1 end] " "]}
product {dict lappend m products [join [lrange $line 1 end] " "]}
doc {dict lappend m docs [lindex $line 1]}
zigpin {dict set m zigpin [lindex $line 1]}
}
}
} cfgerr]} {
dict set m note "(sources.config unreadable: $cfgerr)"
}
return $m
}
proc ::punkboot::buildsuite_dirs {bs_root} {
set dirs [list]
foreach dir [lsort [glob -nocomplain -dir $bs_root -type d *]] {
if {[file tail $dir] eq "_build"} {continue}
if {![file exists [file join $dir suite.tcl]]} {continue} ;#not a suite (no driver)
lappend dirs $dir
}
return $dirs
}
switch -- $bs_action {
list {
set suitedirs [::punkboot::buildsuite_dirs $bs_root]
if {![llength $suitedirs]} {
puts stdout "no buildsuites found under $bs_root (a suite = a directory carrying a suite.tcl driver)"
exit 0
}
puts stdout "buildsuites under $bs_root:"
foreach dir $suitedirs {
set m [::punkboot::buildsuite_manifest $dir]
set desc [dict get $m description]
if {$desc eq ""} {set desc [dict get $m note]}
if {$desc eq ""} {set desc "(no description record in sources.config)"}
puts stdout [format " %-16s %s" [file tail $dir] $desc]
}
puts stdout ""
puts stdout " - 'make.tcl buildsuite info <name>' shows a suite's configured detail"
puts stdout " - 'make.tcl buildsuite build <name> ?driver-args ...?' runs its driver"
exit 0
}
info {
set bs_name [lindex $bsargs 1]
if {$bs_name eq ""} {
puts stderr "usage: make.tcl buildsuite info <suitename> ('make.tcl buildsuite list' shows the names)"
exit 2
}
set dir [file join $bs_root $bs_name]
if {![file isdirectory $dir] || ![file exists [file join $dir suite.tcl]]} {
puts stderr "buildsuite '$bs_name' not found (no [file join $dir suite.tcl]) - 'make.tcl buildsuite list' shows the suites"
exit 2
}
set m [::punkboot::buildsuite_manifest $dir]
puts stdout "buildsuite: $bs_name"
puts stdout " path: $dir"
if {[dict get $m note] ne ""} {puts stdout " note: [dict get $m note]"}
if {[dict get $m description] ne ""} {puts stdout " description: [dict get $m description]"}
if {[llength [dict get $m sources]]} {
puts stdout " sources (sources.config - the live dev-flow refs; the 'zig build' flow pins per-checkin via build.zig.zon):"
puts stdout [format " %-10s %-7s %-40s %-16s %s" name kind url ref dir]
foreach s [dict get $m sources] {
lassign $s sname skind surl sref sdir
puts stdout [format " %-10s %-7s %-40s %-16s %s" $sname $skind $surl $sref $sdir]
}
}
set zigpin [dict get $m zigpin]
if {$zigpin ne ""} {
set pinpath [file normalize [file join $projectroot $zigpin]]
set pinstate [expr {[file exists $pinpath] ? "present" : "NOT PRESENT (bin/punk-getzig.cmd can fetch it)"}]
puts stdout " zig pin: $zigpin ($pinstate)"
} else {
puts stdout " zig pin: (no zigpin record in sources.config)"
}
if {[info exists ::env(PUNK_ZIG)]} {
puts stdout " zig via env: PUNK_ZIG=$::env(PUNK_ZIG) (overrides the pin for driver runs)"
}
foreach p [dict get $m products] {
puts stdout " product: $p"
}
foreach d [dict get $m docs] {
puts stdout " doc: [file join $dir $d]"
}
exit 0
}
build {
set bs_name [lindex $bsargs 1]
if {$bs_name eq ""} {
puts stderr "usage: make.tcl buildsuite build <suitename> ?driver-args ...?"
exit 2
}
set dir [file join $bs_root $bs_name]
set driver [file join $dir suite.tcl]
if {![file exists $driver]} {
puts stderr "buildsuite '$bs_name' not found (no $driver) - 'make.tcl buildsuite list' shows the suites"
exit 2
}
set fwdargs [lrange $bsargs 2 end]
#interpreter for the driver: this tclsh - or, punk-exe-hosted (the
#G-058 static-capture marker identifies a kit boot), the kit's
#'script' subcommand so the driver runs with plain script semantics
set launcher [list [info nameofexecutable]]
if {[info exists ::punkboot::static_packages]} {
set launcher [list [info nameofexecutable] script]
}
puts stdout "buildsuite build $bs_name: running '$driver build' with forwarded args: $fwdargs"
flush stdout
#stream driver output; exit with the driver's status
if {[catch {exec {*}$launcher $driver build {*}$fwdargs >@stdout 2>@stderr} execerr execopts]} {
set ecode [dict get $execopts -errorcode]
if {[lindex $ecode 0] eq "CHILDSTATUS"} {
exit [lindex $ecode 2]
}
puts stderr "buildsuite build $bs_name: failed to run the driver: $execerr"
exit 1
}
exit 0
}
default {
puts stderr "unknown buildsuite action '$bs_action' - expected list|info|build"
puts stderr "usage: make.tcl buildsuite list|info|build ?<suitename>? ?driver-args ...?"
exit 2
}
}
}
if {$::punkboot::command eq "tool"} {
#G-126: vendored first-party build tools under src/tools (zig source vendored in
#full - boundary and editing policy in src/tools/AGENTS.md; per-tree origin,
#re-vendor procedure and licence records in <tool>/PROVENANCE.md). Discovery is
#convention-based: a directory under src/tools carrying build.zig is a tool, its
#name is the directory name, its build artifact is <tooldir>/zig-out/bin/<name>
#and its installed copy is <projectdir>/bin/<name> (host executable suffix).
#zig stays OPTIONAL for punkshell builds: nothing in packages/bake depends on
#this step; explicit build/test without a suitable toolchain exits nonzero with
#fetch guidance. Build caches (.zig-cache/zig-out) are deliberately left in
#place between builds for rebuild speed (both git- and fossil-ignored).
set tool_root [file join $sourcefolder tools]
if {![info exists ::punkboot::tool_args]} {set ::punkboot::tool_args [list]}
set targs $::punkboot::tool_args
set tool_action [lindex $targs 0]
if {$tool_action eq ""} {set tool_action list}
#args after the action: tool names plus an optional '-test 0|1' flag (build)
set tool_dotest 1
set tool_names [list]
set _i 1
while {$_i < [llength $targs]} {
set a [lindex $targs $_i]
if {$a eq "-test"} {
incr _i
set v [lindex $targs $_i]
if {![string is boolean -strict $v]} {
puts stderr "make.tcl tool: -test requires a boolean value (got '$v')"
exit 2
}
set tool_dotest [expr {bool($v)}]
} else {
lappend tool_names $a
}
incr _i
}
unset -nocomplain _i a v
proc ::punkboot::tool_dirs {tool_root} {
set dirs [list]
foreach dir [lsort [glob -nocomplain -dir $tool_root -type d *]] {
if {![file exists [file join $dir build.zig]]} {continue} ;#not a tool
lappend dirs $dir
}
return $dirs
}
#tolerant build.zig.zon reader: tool version + declared minimum zig version
proc ::punkboot::tool_zoninfo {tooldir} {
set m [dict create version "" zigfloor ""]
if {![catch {
set f [open [file join $tooldir build.zig.zon] r]
set data [read $f]
close $f
}]} {
if {[regexp {\.version\s*=\s*"([^"]+)"} $data -> _v]} {dict set m version $_v}
if {[regexp {\.minimum_zig_version\s*=\s*"([^"]+)"} $data -> _fl]} {dict set m zigfloor $_fl}
}
return $m
}
#tolerant PROVENANCE.md reader: vendored upstream commit + upstream location
proc ::punkboot::tool_provenance {tooldir} {
set m [dict create commit "" upstream ""]
if {![catch {
set f [open [file join $tooldir PROVENANCE.md] r]
set data [read $f]
close $f
}]} {
if {[regexp {Vendored state: commit\s+`?([0-9a-fA-F]{7,40})} $data -> _c]} {dict set m commit $_c}
if {[regexp {Upstream repository:\s+`?([^`\n]+)} $data -> _u]} {dict set m upstream [string trim $_u]}
}
return $m
}
proc ::punkboot::tool_newest_src_mtime {dir} {
set newest 0
foreach f [glob -nocomplain -dir $dir -type f *] {
if {[file mtime $f] > $newest} {set newest [file mtime $f]}
}
foreach d [glob -nocomplain -dir $dir -type d *] {
if {[file tail $d] in {zig-out .zig-cache zig-cache}} {continue}
set sub [::punkboot::tool_newest_src_mtime $d]
if {$sub > $newest} {set newest $sub}
}
return $newest
}
proc ::punkboot::tool_zig_version {zigexe} {
if {[catch {exec $zigexe version 2>@1} v]} {return ""}
return [string trim [lindex [split $v \n] 0]]
}
#a dev build's base version must EXCEED the floor (e.g 0.16.0-dev < 0.16.0)
proc ::punkboot::tool_zig_satisfies {ver floor} {
if {$floor eq ""} {return 1}
set base $ver ; set isdev 0
if {[regexp {^([0-9][0-9.]*)[-+]} $ver -> b]} {set base $b ; set isdev 1}
if {[catch {package vcompare $base $floor} cmp]} {return 0}
if {$cmp > 0} {return 1}
if {$cmp == 0 && !$isdev} {return 1}
return 0
}
#resolve a zig for the given floor: PUNK_ZIG env override (path to the zig
#executable or its folder), else scan <projectdir>/bin/tools/zig* preferring
#releases over dev builds and the LOWEST satisfying version - a deterministic
#choice that stays stable as newer toolchains get unpacked beside the pinned one
proc ::punkboot::tool_resolve_zig {projectroot floor} {
if {[info exists ::env(PUNK_ZIG)] && $::env(PUNK_ZIG) ne ""} {
set cand $::env(PUNK_ZIG)
if {[file isdirectory $cand]} {
foreach n {zig.exe zig} {
if {[file exists [file join $cand $n]]} {set cand [file join $cand $n] ; break}
}
}
set v [::punkboot::tool_zig_version $cand]
if {$v eq ""} {
return [dict create note "PUNK_ZIG='$::env(PUNK_ZIG)' did not answer 'zig version'"]
}
if {![::punkboot::tool_zig_satisfies $v $floor]} {
return [dict create note "PUNK_ZIG zig is $v which does not satisfy this tool's floor (>= $floor)"]
}
return [dict create zig $cand version $v via PUNK_ZIG]
}
set best "" ; set bestv "" ; set bestbase "" ; set bestdev 1
foreach dir [lsort [glob -nocomplain -dir [file join $projectroot bin tools] -type d zig*]] {
set p ""
foreach n {zig.exe zig} {
if {[file exists [file join $dir $n]]} {set p [file join $dir $n] ; break}
}
if {$p eq ""} {continue}
set v [::punkboot::tool_zig_version $p]
if {$v eq "" || ![::punkboot::tool_zig_satisfies $v $floor]} {continue}
set base $v ; set isdev 0
if {[regexp {^([0-9][0-9.]*)[-+]} $v -> b]} {set base $b ; set isdev 1}
set take 0
if {$best eq ""} {
set take 1
} elseif {$bestdev && !$isdev} {
set take 1
} elseif {$bestdev == $isdev && [package vcompare $base $bestbase] < 0} {
set take 1
}
if {$take} {set best $p ; set bestv $v ; set bestbase $base ; set bestdev $isdev}
}
if {$best eq ""} {
set want [expr {$floor eq "" ? "any version" : ">= $floor"}]
return [dict create note "no suitable zig toolchain ($want) under [file join $projectroot bin tools] - 'bin/punk-getzig.cmd <version>' fetches one; PUNK_ZIG=<path-to-zig> overrides"]
}
return [dict create zig $best version $bestv via scan]
}
proc ::punkboot::tool_installed_exe {projectroot name} {
set suffix [punkboot::lib::platform_exe_suffix $::punkboot::target_platform]
return [file join $projectroot bin ${name}$suffix]
}
proc ::punkboot::tool_install_state {projectroot tooldir} {
set exe [::punkboot::tool_installed_exe $projectroot [file tail $tooldir]]
if {![file exists $exe]} {return absent}
if {[file mtime $exe] >= [::punkboot::tool_newest_src_mtime $tooldir]} {return current}
return stale
}
#run 'zig <argl>' with cwd at the tool tree (the tree's CLI tests resolve
#fixtures and zig-out relative to the build root). The gate is the EXIT CODE:
#stderr legitimately carries expected warnings (punkzip's zip suite negative
#tests print EOCD warnings while passing). Returns the child's exit status.
proc ::punkboot::tool_zig_run {zig tooldir argl} {
set saved [pwd]
cd $tooldir
set rc 0
if {[catch {exec $zig {*}$argl >@stdout 2>@stderr} _e _o]} {
set ecode [dict get $_o -errorcode]
if {[lindex $ecode 0] eq "CHILDSTATUS"} {
set rc [lindex $ecode 2]
} else {
puts stderr "tool: failed to run '$zig $argl' in $tooldir: $_e"
set rc 1
}
}
cd $saved
return $rc
}
set alldirs [::punkboot::tool_dirs $tool_root]
set byname [dict create]
foreach d $alldirs {dict set byname [file tail $d] $d}
if {[llength $tool_names]} {
set selected [list]
foreach n $tool_names {
if {![dict exists $byname $n]} {
puts stderr "tool '$n' not found under $tool_root - configured tools: [dict keys $byname]"
exit 2
}
lappend selected [dict get $byname $n]
}
} else {
set selected $alldirs
}
if {![llength $alldirs] && $tool_action ne "list"} {
puts stderr "no vendored tools found under $tool_root (a tool = a directory carrying build.zig)"
exit 2
}
switch -- $tool_action {
list {
if {![llength $alldirs]} {
puts stdout "no vendored tools found under $tool_root (a tool = a directory carrying build.zig)"
exit 0
}
puts stdout "vendored tools under $tool_root (boundary: src/tools/AGENTS.md; per-tree PROVENANCE.md):"
puts stdout [format " %-10s %-9s %-10s %-8s %s" name version zig-floor bin vendored-commit]
set maxfloor ""
foreach dir $alldirs {
set name [file tail $dir]
set zon [::punkboot::tool_zoninfo $dir]
set prov [::punkboot::tool_provenance $dir]
set floor [dict get $zon zigfloor]
if {$floor ne "" && ($maxfloor eq "" || [package vcompare $floor $maxfloor] > 0)} {
set maxfloor $floor
}
set commit [dict get $prov commit]
set commit [expr {$commit eq "" ? "-" : [string range $commit 0 11]}]
set floorshow [expr {$floor eq "" ? "-" : ">=$floor"}]
puts stdout [format " %-10s %-9s %-10s %-8s %s" $name [dict get $zon version] $floorshow [::punkboot::tool_install_state $projectroot $dir] $commit]
}
set zres [::punkboot::tool_resolve_zig $projectroot $maxfloor]
if {[dict exists $zres zig]} {
puts stdout "toolchain: zig [dict get $zres version] via [dict get $zres via] ([dict get $zres zig])"
} else {
puts stdout "toolchain: [dict get $zres note]"
}
puts stdout ""
puts stdout " - 'make.tcl tool info <name>' shows a tool's detail"
puts stdout " - 'make.tcl tool build ?<name> ...? ?-test 0|1?' builds (test-gated) and installs to bin/"
puts stdout " - zig is OPTIONAL for punkshell builds: packages/bake never require this step"
exit 0
}
info {
if {![llength $tool_names]} {
puts stderr "usage: make.tcl tool info <toolname> ('make.tcl tool list' shows the names)"
exit 2
}
foreach dir $selected {
set name [file tail $dir]
set zon [::punkboot::tool_zoninfo $dir]
set prov [::punkboot::tool_provenance $dir]
set floor [dict get $zon zigfloor]
puts stdout "tool: $name"
puts stdout " path: $dir"
puts stdout " version: [dict get $zon version] (build.zig.zon)"
puts stdout " zig floor: [expr {$floor eq "" ? "(none declared)" : ">= $floor"}]"
puts stdout " upstream: [expr {[dict get $prov upstream] eq "" ? "(no PROVENANCE.md record)" : [dict get $prov upstream]}]"
puts stdout " vendored commit: [expr {[dict get $prov commit] eq "" ? "(no PROVENANCE.md record)" : [dict get $prov commit]}]"
puts stdout " provenance: [file join $dir PROVENANCE.md]"
set exe [::punkboot::tool_installed_exe $projectroot $name]
puts stdout " installed: $exe ([::punkboot::tool_install_state $projectroot $dir])"
set zres [::punkboot::tool_resolve_zig $projectroot $floor]
if {[dict exists $zres zig]} {
puts stdout " toolchain: zig [dict get $zres version] via [dict get $zres via] ([dict get $zres zig])"
} else {
puts stdout " toolchain: [dict get $zres note]"
}
}
exit 0
}
build {
foreach dir $selected {
set name [file tail $dir]
set floor [dict get [::punkboot::tool_zoninfo $dir] zigfloor]
set zres [::punkboot::tool_resolve_zig $projectroot $floor]
if {![dict exists $zres zig]} {
puts stderr "tool build $name: [dict get $zres note]"
exit 1
}
set zig [dict get $zres zig]
puts stdout "tool build $name: zig [dict get $zres version] via [dict get $zres via] ($zig)"
flush stdout
if {$tool_dotest} {
puts stdout "tool build $name: test gate ('zig build test') ..."
flush stdout
set rc [::punkboot::tool_zig_run $zig $dir [list build test]]
if {$rc != 0} {
puts stderr "tool build $name: test gate FAILED (exit $rc) - nothing installed"
exit 1
}
puts stdout "tool build $name: test gate passed"
} else {
puts stdout "tool build $name: test gate SKIPPED (-test 0)"
}
puts stdout "tool build $name: building (ReleaseSafe) ..."
flush stdout
set rc [::punkboot::tool_zig_run $zig $dir [list build -Doptimize=ReleaseSafe]]
if {$rc != 0} {
puts stderr "tool build $name: build FAILED (exit $rc) - nothing installed"
exit 1
}
set suffix [punkboot::lib::platform_exe_suffix $::punkboot::target_platform]
set built [file join $dir zig-out bin ${name}$suffix]
if {![file exists $built]} {
puts stderr "tool build $name: build reported success but $built is missing"
exit 1
}
set exe [::punkboot::tool_installed_exe $projectroot $name]
if {[catch {file copy -force $built $exe} cperr]} {
puts stderr "tool build $name: could not install $exe ($cperr) - is a copy currently running?"
exit 1
}
puts stdout "tool build $name: installed $exe ([file size $exe] bytes)"
}
exit 0
}
test {
foreach dir $selected {
set name [file tail $dir]
set floor [dict get [::punkboot::tool_zoninfo $dir] zigfloor]
set zres [::punkboot::tool_resolve_zig $projectroot $floor]
if {![dict exists $zres zig]} {
puts stderr "tool test $name: [dict get $zres note]"
exit 1
}
set zig [dict get $zres zig]
puts stdout "tool test $name: zig [dict get $zres version] via [dict get $zres via] - running 'zig build test' ..."
flush stdout
set rc [::punkboot::tool_zig_run $zig $dir [list build test]]
if {$rc != 0} {
puts stderr "tool test $name: FAILED (exit $rc)"
exit 1
}
puts stdout "tool test $name: passed"
}
exit 0
}
default {
puts stderr "unknown tool action '$tool_action' - expected list|info|build|test"
puts stderr "usage: make.tcl tool list|info|build|test ?<toolname> ...? ?-test 0|1?"
exit 2
}
}
}
if {$::punkboot::command eq "shell"} {
#G-113: the ansistrip transform serves make.tcl's own output only - the repl's
#colour behaviour is the shell's own concern (colour on/off + NO_COLOR there).
#Pop exactly the channels the policy block wrapped (per-channel list).
if {[info exists ::punkboot::ansistrip_pushed]} {
foreach _ch $::punkboot::ansistrip_pushed {
catch {chan pop $_ch}
}
set ::punkboot::ansistrip_pushed [list]
}
package require struct::list
package require punk
package require punk::repl
#todo - make procs vars etc from this file available?
puts stderr "punk boot shell not implemented - dropping into ordinary punk shell."
set ::argv [lrange $::argv 1 end]
incr ::argc -1
#When make.tcl runs under a built punk executable, app-punkscript set
#::tcl_interactive 0 (correct for script execution) and punk::repl was already loaded
#at kit boot - the package require above re-loads nothing, so the repl's load-time
#interactivity probe never re-ran and prompts would stay suppressed on a real console.
#Recompute against the actual input channel now that a shell has been explicitly asked for.
set ::tcl_interactive [punk::repl::is_interactive stdin]
repl::init
set replresult [repl::start stdin -title make.tcl]
#review
if {[string is integer -strict $replresult]} {
exit $replresult
} else {
puts stdout $replresult
exit 0
}
}
if {$::punkboot::command eq "vfscommonupdate"} {
puts "projectroot: $projectroot"
puts "script: [info script]"
puts stdout "Updating vfs/_vfscommon.vfs"
#G-030 prompt policy: -confirm 0 proceeds without prompting; with the default -confirm 1
#a non-interactive stdin aborts fast with guidance instead of reading stdin.
set _proceed 0
if {!$::punkboot::opt_confirm} {
puts stdout "REPLACE src/vfs/_vfscommon.vfs/* with project's modules and libs (-confirm 0 supplied - proceeding without prompting)"
set _proceed 1
} elseif {![::punkboot::lib::stdin_is_interactive]} {
puts stderr "-aborted- (vfscommonupdate REPLACE confirmation required but stdin is not interactive)"
puts stderr " Rerun with -confirm 0 to proceed without prompting (see 'make.tcl vfscommonupdate -help')."
exit 1
} else {
puts stdout "REPLACE src/vfs/_vfscommon.vfs/* with project's modules and libs?? y|n"
if {[string tolower [string trim [gets stdin]]] eq "y"} {
set _proceed 1
}
}
if {!$_proceed} {
puts stderr "-aborted- by user (vfscommonupdate: no changes made)"
exit 1
}
puts proceeding...
proc vfscommonupdate {projectroot} {
file delete -force $projectroot/src/vfs/_vfscommon.vfs/modules
file copy $projectroot/modules $projectroot/src/vfs/_vfscommon.vfs/
#temp? (avoid zipfs mkimg windows dotfile bug)
file delete $projectroot/src/vfs/_vfscommon.vfs/modules/.punkcheck
file delete -force $projectroot/src/vfs/_vfscommon.vfs/lib
file copy $projectroot/lib $projectroot/src/vfs/_vfscommon.vfs/
#temp?
file delete $projectroot/src/vfs/_vfscommon.vfs/lib/.punkcheck
}
vfscommonupdate $projectroot
puts stdout "\nvfscommonupdate done "
flush stderr
flush stdout
::exit 0
}
if {$::punkboot::command eq "vendorupdate"} {
puts "projectroot: $projectroot"
puts "script: [info script]"
#puts "-- [tcl::tm::list] --"
puts stdout "Updating vendor modules in src folder"
#dirty-checkout provenance warnings via punkboot::utils::vcs_dirty_warnings (loaded from bootsupport).
#Guarded require: vendorupdate must keep working even if the bootsupport punkboot::utils copy is
#missing or stale (it may be the very thing being repaired) - the check degrades to skipped.
set have_vcs_dirty_check [expr {![catch {package require punkboot::utils}] && [llength [info commands ::punkboot::utils::vcs_dirty_warnings]]}]
if {!$have_vcs_dirty_check} {
puts stderr "WARNING: vendorupdate dirty-checkout provenance check unavailable (punkboot::utils vcs_dirty_warnings not loadable from bootsupport) - continuing without it"
}
proc vendor_localupdate {projectroot} {
set local_modules [list]
set git_modules [list]
set fossil_modules [list]
set checked_source_paths [dict create] ;#skip repeat walk-ups for identical source paths
set checked_vcs_roots [dict create] ;#report each VCS root at most once per run
set sourcefolder $projectroot/src
#todo vendor/lib
set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib_tcl*]
#todo platform folders under vendor/lib_tcl<v>
#todo platform folders under vendor/module_tcl<v>
set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*]
#lappend vendormodulefolders vendormodules
foreach vf $vendormodulefolders {
lassign [split $vf _] _vm tclx
if {$tclx ne ""} {
set which _$tclx
} else {
set which ""
}
set vendor_config $sourcefolder/vendormodules$which/include_modules.config ;#todo - change to toml
if {[file exists $vendor_config]} {
set targetroot $sourcefolder/vendormodules$which
set local_modules [list]
source $vendor_config ;#populate $local_modules $git_modules $fossil_modules with project-specific list
if {![llength $local_modules]} {
puts stderr "\nsrc/vendormodules$which No local vendor modules configured for updating (config file: $vendor_config)"
} else {
if {[catch {
#----------
set vendor_installer [punkcheck::installtrack new make.tcl $sourcefolder/vendormodules$which/.punkcheck]
$vendor_installer set_source_target $projectroot $sourcefolder/vendormodules$which
set installation_event [$vendor_installer start_event {-make_step vendorupdate}]
#----------
} errM]} {
puts stderr "Unable to use punkcheck for vendormodules$which update. Error: $errM"
set installation_event ""
}
#todo - sync alg with bootsupport_localupdate!
foreach {localpath requested_module} $local_modules {
set requested_module [string trim $requested_module :]
set module_subpath [string map {:: /} [namespace qualifiers $requested_module]]
if {[file pathtype $localpath] eq "relative"} {
#This would actually work for absolute paths too as file join c:/test c:/etc ignores first arg and returns c:/etc
set srclocation [file join $projectroot $localpath $module_subpath]
} else {
set srclocation [file join $localpath $module_subpath]
}
#dirty-checkout provenance check - each VCS root reported at most once per run
if {$::have_vcs_dirty_check} {
set normsrclocation [file normalize $srclocation]
if {![dict exists $checked_source_paths $normsrclocation]} {
dict set checked_source_paths $normsrclocation 1
::punkboot::print_provenance_warnings [::punkboot::utils::vcs_dirty_warnings $normsrclocation checked_vcs_roots vendorupdate]
}
}
#puts stdout "$relpath $module $module_subpath $srclocation"
#todo - check if requested_module has version extension and allow explicit versions instead of just latest
#allow modulename-* literal in .config to request all versions
set pkgmatches [glob -nocomplain -dir $srclocation -tail -- [namespace tail $requested_module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing local source for requested vendor module $requested_module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0] ;#default
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$installation_event ne ""} {
#----------
$installation_event targetset_init INSTALL $tgtfile
$installation_event targetset_addsource $srcfile
#----------
if {\
[llength [dict get [$installation_event targetset_source_changes] changed]]\
|| [llength [$installation_event get_targets_exist]] < [llength [$installation_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$installation_event targetset_started
# -- --- --- --- --- ---
puts "VENDORMODULES$which update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$installation_event targetset_end FAILED
} else {
$installation_event targetset_end OK
}
# -- --- --- --- --- ---
} else {
puts -nonewline stderr "."
$installation_event targetset_end SKIPPED
}
$installation_event end
} else {
file copy -force $srcfile $tgtfile
}
}
}
} else {
puts stderr "No config at $vendor_config - nothing configured to update"
}
}
}
vendor_localupdate $projectroot
puts stdout " vendor package update done "
flush stderr
flush stdout
::exit 0
}
if {$::punkboot::command eq "bootsupport"} {
puts "projectroot: $projectroot"
puts "script: [info script]"
#puts "-- [tcl::tm::list] --"
puts stdout "Updating bootsupport from local files"
proc modfile_sort {p1 p2} {
lassign [split [file rootname $p1] -] _ v1
lassign [split [file rootname $p2] -] _ v2
package vcompare $v1 $v2
}
proc bootsupport_localupdate {projectroot} {
set sourcefolder $projectroot/src
set bootmodulefolders [glob -nocomplain -dir $sourcefolder/bootsupport -type d -tails modules modules_tcl*]
foreach bm $bootmodulefolders {
lassign [split $bm _] _bm tclx
if {$tclx ne ""} {
set which _$tclx
} else {
set which ""
}
set bootsupport_config $projectroot/src/bootsupport/modules$which/include_modules.config ;#
set bootsupport_modules [list] ;#variable populated by include_modules.config file - initialise empty for each bm folder
set bootsupport_folders [list]
if {[file exists $bootsupport_config]} {
set targetroot $projectroot/src/bootsupport/modules$which
source $bootsupport_config ;#populate $bootsupport_modules with project-specific list
if {![llength $bootsupport_modules]} {
puts stderr "bootsupport/modules$which - No local bootsupport modules configured for updating"
} else {
if {[catch {
#----------
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
foreach {relpath modulematch} $bootsupport_modules {
set modulematch [string trim $modulematch :]
set module_subpath [string map [list :: /] [namespace qualifiers $modulematch]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $modulematch $module_subpath $srclocation"
#we must always glob using the dash - or we will match libraries that are suffixes of others
#bare lib.tm with no version is not valid.
if {[string first - $modulematch] != -1} {
#version or part thereof is specified.
set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f -- [namespace tail $modulematch]*.tm]
} else {
set pkgmatches [glob -nocomplain -dir $srclocation -tail -type f -- [namespace tail $modulematch]-*.tm]
}
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $modulematch - no matches in $srclocation"
continue
}
set modulematch_is_glob [regexp {[*?\[\]]} $modulematch]
if {!$modulematch_is_glob} {
#if modulematch was specified without globs - only copy latest
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1b3 - use helper func
set pkgmatches [lsort -command modfile_sort $pkgmatches]
set latestfile [lindex $pkgmatches end]
#set latestver [lindex [split [file rootname $latestfile] -] 1]
set copy_files $latestfile
} else {
#globs in modulematch - may be different packages matched by glob - copy all versions of matches
#review
set copy_files $pkgmatches
}
#if a file added manually to target dir - there will be no .punkcheck record - will be detected as changed
foreach cfile $copy_files {
set srcfile [file join $srclocation $cfile]
set tgtfile [file join $targetroot $module_subpath $cfile]
if {$boot_event ne ""} {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
catch {
#virtual module identity/version sources so records identify the product
#(guarded - older punkcheck snapshots lack targetset_addsource_virtual)
lassign [punk::mix::util::split_modulename_version [file tail $cfile]] bs_module_name bs_module_version
if {$bs_module_version ne ""} {
$boot_event targetset_addsource_virtual module_name $bs_module_name
$boot_event targetset_addsource_virtual module_version $bs_module_version
}
}
#----------
#
#puts "bootsuport target $tgtfile record size: [dict size [$boot_event targetset_last_complete]]"
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "\nBOOTSUPPORT module$which update: $srcfile -> $tgtfile"
#An in-place overwrite is refused when the target is memory-mapped -
#which is what a mounted zip-based .tm modpod (e.g punk::mix::templates)
#is. replace_possibly_mapped_file falls back to delete-then-place, which
#windows does allow. See its comment for why the error reads "invalid
#argument" and why unlinking is safe for the process holding the mapping.
switch -- [::punkboot::replace_possibly_mapped_file $srcfile $tgtfile errM] {
ok {
$boot_event targetset_end OK
}
replaced {
puts stdout " (in-place overwrite refused - replaced by delete-then-place; target was memory-mapped, e.g a mounted modpod)"
$boot_event targetset_end OK -note "overwrite refused ($errM) - replaced via delete-then-place (target memory-mapped)"
}
broken {
puts stderr "BOOTSUPPORT module$which update FAILED: $tgtfile was unlinked and could not be replaced - restore it from $srcfile by hand ($errM)"
$boot_event targetset_end FAILED
}
default {
#target untouched. If its content is already identical, record OK so a
#prior failed record converges instead of churning FAILED forever.
set already_current 0
if {[file exists $tgtfile] && [file size $tgtfile] == [file size $srcfile]} {
catch {
set src_ck [dict get [punk::mix::base::lib::cksum_path $srcfile] cksum]
set tgt_ck [dict get [punk::mix::base::lib::cksum_path $tgtfile] cksum]
if {$src_ck ne "" && $src_ck eq $tgt_ck} {
set already_current 1
}
}
}
if {$already_current} {
$boot_event targetset_end OK -note "copy failed ($errM) but target content already identical"
} else {
puts stderr "BOOTSUPPORT module$which update FAILED: $tgtfile ($errM)"
set _hint [::punkboot::mapped_file_hint $errM $tgtfile]
if {$_hint ne ""} {
puts stderr " $_hint"
}
$boot_event targetset_end FAILED
}
}
}
# -- --- --- --- --- ---
} else {
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
}
$boot_event end
} else {
file copy -force $srcfile $tgtfile
}
}
if {!$modulematch_is_glob && $boot_event ne ""} {
#non-glob config entry means only the latest version is tracked
# - prune superseded punkcheck-recorded older versions from the bootsupport folder
if {![catch {package require punk::mix::cli}]
&& ![catch {package require punk::mix::util}]
&& [llength [info commands ::punk::mix::cli::lib::prune_superseded_target_modules]]
} {
lassign [punk::mix::util::split_modulename_version [file tail $latestfile]] mod_basename mod_version
if {$mod_version ne ""} {
::punk::mix::cli::lib::prune_superseded_target_modules $boot_event $projectroot/src/bootsupport [file join $targetroot $module_subpath] $mod_basename $mod_version
}
} else {
if {![info exists ::punkboot::warned_prune_helper_unavailable]} {
set ::punkboot::warned_prune_helper_unavailable 1
puts stderr "bootsupport: prune helper punk::mix::cli::lib::prune_superseded_target_modules unavailable (older punk::mix::cli snapshot) - skipping prune of superseded bootsupport modules. Rerun 'make.tcl bootsupport' after rebuilding modules and bootsupport."
}
}
}
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
}
}
if {![llength $bootsupport_folders]} {
puts stderr "bootsupport/modules$which - No local bootsupport folders configured for updating"
} else {
}
}
}
}
bootsupport_localupdate $projectroot
#G-087 stage 3: the former custom/_project layout bootsupport sync is retired.
#Project layouts store no bootsupport module snapshots - 'dev project.new' injects bootsupport
#into generated projects from the generating shell at generation time. Layout-carried scripts
#and bootsupport manifests are kept current by the thin-layout sync step (see DIAGRAM 1b in
#::punkboot::workflow_text), which runs during modules/libs/packages/bakehouse builds.
puts stdout " bootsupport done "
flush stderr
flush stdout
#punk86 can hang if calling make.tcl via 'run' without this 'after' delay. punk87 unaffected. cause unknown.
#after 500
::exit 0
}
if {$::punkboot::command ni {bakehouse packages modules libs bake vfslibs bin}} {
puts stderr "Command $::punkboot::command not implemented - aborting."
flush stderr
after 100
exit 1
}
#external libs and modules first - and any supporting files - no 'building' required
#install src vendor contents (from version controlled src folder) to base of project (same target folders as our own src/modules etc ie to paths that go on the auto_path and in tcl::tm::list)
if {$::punkboot::command in {bakehouse packages modules}} {
set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*]
foreach vf $vendormodulefolders {
lassign [split $vf _] _vm tclx
if {$tclx ne ""} {
set which _$tclx
} else {
set which ""
}
set target_module_folder $projectroot/modules$which
file mkdir $target_module_folder
#install .tm *and other files*
puts stdout "VENDORMODULES$which: copying from $sourcefolder/$vf to $target_module_folder (if source file changed)"
set resultdict [punkcheck::install $sourcefolder/$vf $target_module_folder {*}{
-installer make.tcl
-overwrite installedsourcechanged-targets
-progresschannel stdout
-exclude-filetails {AGENTS.md include_modules.config}
-exclude-paths {README.md}
}]
# -exclude-paths {README.md AGENTS.md **/AGENTS.md include_modules.config}
#-exclude-filetails {AGENTS.md include_modules.config}
#-exclude-paths {README.md}
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
if {![catch {package require punk::mix::cli}]
&& [llength [info commands ::punk::mix::cli::lib::prune_sourcevanished_targets]]
} {
#remove make.tcl-installed .tm copies whose recorded source files no longer exist
#(e.g vendormodule versions deleted from src/vendormodules)
::punk::mix::cli::lib::prune_sourcevanished_targets $target_module_folder make.tcl -glob *.tm
} else {
puts stderr "VENDORMODULES$which: prune helper punk::mix::cli::lib::prune_sourcevanished_targets unavailable (older punk::mix::cli snapshot) - skipping sourcevanished prune for $target_module_folder"
}
}
if {![llength $vendormodulefolders]} {
puts stderr "VENDORMODULES: No src/vendormodules or src/vendormodules_tcl* folders found."
}
}
if {$::punkboot::command in {bakehouse packages libs}} {
#exclude README.md from source folder - but only the root one
#-exclude-paths takes relative patterns e.g
# */test.txt will only match test.txt exactly one level deep.
# */*/*.foo will match any path ending in .foo that is exactly 2 levels deep.
# **/test.txt will match at any level below the root (but not in the root)
set antipaths [list {*}{
README.md
AGENTS.md
**/AGENTS.md
}]
#step1 - vendorlib - pkgIndex.tcl based libraries that are platform neutral and tcl-majorversion neutral
set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib]
foreach lf $vendorlibfolders {
set source_lib_folder $sourcefolder/$lf
set target_lib_folder $projectroot/lib
file mkdir $target_lib_folder
puts stdout "VENDORLIB: copying tcl-version neutral and platform neutral libraries from $source_lib_folder to $target_lib_folder (if source file changed)"
set resultdict [punkcheck::install $source_lib_folder $target_lib_folder\
-overwrite installedsourcechanged-targets\
-exclude-paths $antipaths\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
if {![llength $vendorlibfolders]} {
puts stderr "VENDORLIB: No src/vendorlib folder found."
}
#step2 - vendorlib_tcl<majorv> - platform-neutral in 'allplatforms' folder + platform specific based on current platform
set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib_tcl*]
foreach lf $vendorlibfolders {
lassign [split $lf _] _vm which ;#which is tcl8|tcl9 etc
set source_lib_folder $sourcefolder/vendorlib_$which/allplatforms
set target_lib_folder $projectroot/lib_$which/allplatforms
if {[file exists $source_lib_folder] && [llength [punkboot::lib::folder_nondotted_folders $source_lib_folder]]} {
file mkdir $target_lib_folder
puts stdout "VENDORLIB_$which: copying from $source_lib_folder to $target_lib_folder (if source file changed)"
set resultdict [punkcheck::install $source_lib_folder $target_lib_folder\
-overwrite installedsourcechanged-targets\
-exclude-paths $antipaths\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
} else {
puts stdout "$A(BAD)VENDORLIB_$which - no platform neutral folder found at $source_lib_folder$A(RST)"
}
#this_platform_generic
set source_lib_folder $sourcefolder/vendorlib_$which/$this_platform_generic
set target_lib_folder $projectroot/lib_$which/$this_platform_generic
if {[file exists $source_lib_folder] && [llength [punkboot::lib::folder_nondotted_folders $source_lib_folder]]} {
file mkdir $target_lib_folder
puts stdout "VENDORLIB_$which: copying from $source_lib_folder to $target_lib_folder (if source file changed)"
set resultdict [punkcheck::install $source_lib_folder $target_lib_folder\
-overwrite installedsourcechanged-targets\
-exclude-paths $antipaths\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
} else {
puts stdout "$A(BAD)mVENDORLIB_$which - no platform specific folder found at $source_lib_folder$A(RST)"
}
}
if {![llength $vendorlibfolders]} {
puts stderr "$A(BAD)VENDORLIB: No src/vendorlib or src/vendorlib_tcl* folder found.$A(RST)"
}
}
if {$::punkboot::command in {bakehouse bake vfslibs}} {
#G-037: propagate declared vendored platform-library packages into kit vfs lib_tcl<N> trees.
#Participation is per-package per-kit (kit vfs package sets intentionally differ - e.g. twapi
#versions vary per kit) - declared in src/runtime/vendorlib_vfs.toml, never blanket-copied.
#punkcheck records live at src/vfs/.punkcheck so they are not baked into kit payloads.
set vfslibs_config $sourcefolder/runtime/vendorlib_vfs.toml
if {![file exists $vfslibs_config]} {
puts stdout "VFSLIBS: no config at $vfslibs_config - skipping vendorlib -> kit vfs propagation"
} else {
if {[catch {package require tomlish} tomlish_err]} {
puts stderr "$A(BAD)VFSLIBS: cannot process $vfslibs_config - tomlish package unavailable ($tomlish_err)$A(RST)"
exit 3
}
set fd [open $vfslibs_config r]
fconfigure $fd -encoding utf-8
set vfslibs_tomldata [read $fd]
close $fd
if {[catch {tomlish::to_dict [tomlish::from_toml $vfslibs_tomldata]} vfslibs_dict]} {
puts stderr "$A(BAD)VFSLIBS: failed to parse $vfslibs_config\n$vfslibs_dict$A(RST)"
exit 3
}
#tomlish::to_dict values are type-tagged (e.g {type STRING value x}, {type ARRAY value {...}})
proc ::punkboot::lib::toml_untag {tagged} {
if {[dict get $tagged type] eq "ARRAY"} {
set plain [list]
foreach el [dict get $tagged value] {
lappend plain [::punkboot::lib::toml_untag $el]
}
return $plain
}
return [dict get $tagged value]
}
set vfslibs_installs [dict create]
if {[dict exists $vfslibs_dict install]} {
set vfslibs_installs [dict get $vfslibs_dict install]
}
if {![dict size $vfslibs_installs]} {
puts stdout "VFSLIBS: no \[install.<name>\] entries found in $vfslibs_config"
}
dict for {iname ientry} $vfslibs_installs {
foreach reqkey {source targets} {
if {![dict exists $ientry $reqkey]} {
puts stderr "$A(BAD)VFSLIBS: entry install.$iname in $vfslibs_config is missing required key '$reqkey'$A(RST)"
exit 3
}
}
set isource [punkboot::lib::toml_untag [dict get $ientry source]]
set itargets [punkboot::lib::toml_untag [dict get $ientry targets]]
set isupersedes [list]
if {[dict exists $ientry supersedes]} {
set isupersedes [punkboot::lib::toml_untag [dict get $ientry supersedes]]
}
set source_pkg_folder $sourcefolder/$isource
if {![file isdirectory $source_pkg_folder]} {
puts stderr "$A(BAD)VFSLIBS: entry install.$iname source '$isource' not found at $source_pkg_folder$A(RST)"
exit 3
}
set pkgtail [file tail $source_pkg_folder]
foreach t $itargets {
set target_vfs_dir [lindex [file split $t] 0]
if {[llength $::punkboot::bake_selected_kitnames] && $target_vfs_dir ni $::punkboot::bake_selected_vfs} {
#G-121 selective bake: narrow the vfslibs phase to the selected kits'
#vfs folders (skip precedes the existence check so an unselected
#entry's problem cannot abort a selective run)
puts stdout "VFSLIBS install.$iname: skipping vfs/$t (selective bake - not a selected kit's vfs)"
continue
}
if {![file isdirectory $sourcefolder/vfs/$target_vfs_dir]} {
puts stderr "$A(BAD)VFSLIBS: entry install.$iname target '$t' - no vfs folder at $sourcefolder/vfs/$target_vfs_dir$A(RST)"
exit 3
}
set target_lib_folder $sourcefolder/vfs/$t
file mkdir $target_lib_folder
#supersession first - no silent mixed-version provision (G-035 concerns)
foreach sup $isupersedes {
if {$sup eq $pkgtail} {
continue ;#never remove what we are about to install
}
set suppath $target_lib_folder/$sup
if {[file exists $suppath]} {
puts stdout "VFSLIBS install.$iname: removing superseded '$sup' from vfs/$t"
file delete -force $suppath
}
}
puts stdout "VFSLIBS install.$iname: $isource -> vfs/$t/$pkgtail (if source file changed)"
set resultdict [punkcheck::install $source_pkg_folder $target_lib_folder/$pkgtail\
-installer make.tcl\
-createdir 1\
-overwrite installedsourcechanged-targets\
-punkcheck-folder $sourcefolder/vfs\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
}
}
}
if {$::punkboot::command in {bakehouse packages libs}} {
########################################################
lappend projectlibfolders lib
#exclude README.md from source folder - but only the root one
#-exclude-paths takes relative patterns e.g
# */test.txt will only match test.txt exactly one level deep.
# */*/*.foo will match any path ending in .foo that is exactly 2 levels deep.
# **/test.txt will match at any level below the root (but not in the root)
set antipaths [list {*}{
README.md
AGENTS.md
**/AGENTS.md
}]
#step1 - src/lib - pkgIndex.tcl based libraries that are platform neutral and tcl-majorversion neutral
set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib]
foreach lf $projectlibfolders {
set target_lib_folder $projectroot/lib
file mkdir $target_lib_folder
puts stdout "PROJECTLIB: copying from $sourcefolder/$lf to $target_lib_folder (if source file changed)"
set resultdict [punkcheck::install $sourcefolder/$lf $target_lib_folder\
-overwrite installedsourcechanged-targets\
-exclude-paths $antipaths\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
if {![llength $projectlibfolders]} {
puts stderr "PROJECTLIB: No src/lib folder found."
}
#step2 - src/lib_<majorv> - platform-neutral in 'allplatforms' folder + platform specific based on current platform
set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*]
foreach lf $projectlibfolders {
lassign [split $lf _] _vm which
set source_lib_folder $sourcefolder/lib_$which/allplatforms
set target_lib_folder $projectroot/lib_$which/allplatforms
if {[file exists $source_lib_folder] && [llength [punkboot::lib::folder_nondotted_folders $source_lib_folder]]} {
file mkdir $target_lib_folder
puts stdout "PROJECTLIB_$which: copying from $source_lib_folder to $target_lib_folder (if source file changed)"
set resultdict [punkcheck::install $source_lib_folder $target_lib_folder\
-overwrite installedsourcechanged-targets\
-exclude-paths $antipaths\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
} else {
puts stdout "$A(BAD)mPROJECTLIB_$which - no platform neutral folder found at $source_lib_folder$A(RST)"
}
#this_platform_generic
set source_lib_folder $sourcefolder/lib_$which/$this_platform_generic
set target_lib_folder $projectroot/lib_$which/$this_platform_generic
if {[file exists $source_lib_folder] && [llength [punkboot::lib::folder_nondotted_folders $source_lib_folder]]} {
file mkdir $target_lib_folder
puts stdout "PROJECTLIB_$which: copying from $source_lib_folder to $target_lib_folder (if source file changed)"
set resultdict [punkcheck::install $source_lib_folder $target_lib_folder\
-overwrite installedsourcechanged-targets\
-exclude-paths $antipaths\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
} else {
puts stdout "$A(BAD)mPROJECTLIB_$which - no platform specific folder found at $source_lib_folder$A(RST)"
}
}
if {![llength $projectlibfolders]} {
puts stderr "PROJECTLIB: No src/lib_tcl* folder found."
}
}
if {$::punkboot::command in {bakehouse packages modules libs}} {
########################################################
#templates - thin-layout sync (G-087 stage 3; see DIAGRAM 1b in ::punkboot::workflow_text)
#sync boot scripts (build.tcl, make.tcl) and bootsupport include_modules.config manifests into the
#thin vendor layouts (those that carry src/make.tcl), then sync the punk.project layout payload from
#the store into the punk::mix::templates modpod source tree so the built module ships it.
#Layouts store no bootsupport/vfs module snapshots - 'dev project.new' injects bootsupport into
#generated projects from the generating shell at generation time.
set layout_bases [list {*}{
} $sourcefolder/project_layouts/vendor/punk {*}{
}
]
foreach layoutbase $layout_bases {
if {![file exists $layoutbase]} {
continue
}
set project_layouts [glob -nocomplain -dir $layoutbase -type d -tail *]
foreach layoutname $project_layouts {
if {![file exists $layoutbase/$layoutname/src/make.tcl]} {
#layout doesn't carry boot scripts (e.g minimal, sample-0.1) - nothing to sync
continue
}
set config [dict create {*}{
-make-step sync_layouts
}]
#----------
set tpl_installer [punkcheck::installtrack new make.tcl $sourcefolder/project_layouts/.punkcheck]
$tpl_installer set_source_target $sourcefolder $layoutbase/$layoutname
set tpl_event [$tpl_installer start_event $config]
#----------
set pairs [list {*}{
} [list $sourcefolder/build.tcl $layoutbase/$layoutname/src/build.tcl] {*}{
} [list $sourcefolder/make.tcl $layoutbase/$layoutname/src/make.tcl] {*}{
}
]
#bootsupport manifests: sync only into bootsupport modules folders the layout already carries
foreach bm [glob -nocomplain -dir $layoutbase/$layoutname/src/bootsupport -type d -tails modules modules_tcl*] {
set src_manifest $sourcefolder/bootsupport/$bm/include_modules.config
if {[file exists $src_manifest]} {
lappend pairs [list $src_manifest $layoutbase/$layoutname/src/bootsupport/$bm/include_modules.config]
}
}
foreach filepair $pairs {
lassign $filepair srcfile tgtfile
file mkdir [file dirname $tgtfile]
#----------
$tpl_event targetset_init INSTALL $tgtfile
$tpl_event targetset_addsource $srcfile
#----------
if { [llength [dict get [$tpl_event targetset_source_changes] changed]]
|| [llength [$tpl_event get_targets_exist]] < [llength [$tpl_event get_targets]]
} {
$tpl_event targetset_started
# -- --- --- --- --- ---
puts stdout "PROJECT LAYOUT update - layoutname: $layoutname Copying from $srcfile to $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$tpl_event targetset_end FAILED -note "layout:$layoutname copy failed with err: $errM"
} else {
$tpl_event targetset_end OK -note "layout:$layoutname"
}
# -- --- --- --- --- ---
} else {
puts stderr "."
$tpl_event targetset_end SKIPPED
}
}
$tpl_event end
$tpl_event destroy
$tpl_installer destroy
}
}
#store -> modpod payload sync: the punk::mix::templates module ships the thin punk.project layout
#so module-pathtype layout refs resolve and a bare kit outside any project can generate from it.
#The modpod copy is build-managed - do not hand-edit it. Excludes: bin/sdx.kit (no new binaries
#inside zip-based .tm modules). (The unimplemented child-side src/PROJECT_LAYOUTS_* marker was
#retired by G-087 stage 5 - thin layouts + generation-time injection made it moot.)
set store_layout $sourcefolder/project_layouts/vendor/punk/project-0.1
set modpod_layout "$sourcefolder/modules/punk/mix/#modpod-templates-999999.0a1.0/templates/project_layouts/vendor/punk/project-0.1"
if {[file isdirectory $store_layout]} {
file mkdir $modpod_layout
puts stdout "LAYOUT->MODPOD: syncing thin punk.project layout payload into punk::mix::templates modpod source (if source file changed)"
#override the default core excludes: .fossil-custom/.fossil-settings are layout content the
#generated project needs (project.new installs them into projects with the same override)
set resultdict [punkcheck::install $store_layout $modpod_layout {*}{
-punkcheck-folder
} $sourcefolder/project_layouts {*}{
-installer make.tcl
-overwrite installedsourcechanged-targets
-createempty 1
-exclude-paths-core {#* **/#* _aside **/_aside _build **/_build .git **/.git}
-exclude-paths {bin/sdx.kit}
}]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
if {![catch {package require punk::mix::cli}]
&& [llength [info commands ::punk::mix::cli::lib::prune_sourcevanished_targets]]
} {
#remove synced layout/modpod copies whose recorded source files no longer exist
::punk::mix::cli::lib::prune_sourcevanished_targets $sourcefolder/project_layouts make.tcl -glob *
} else {
puts stderr "sync_layouts: prune helper punk::mix::cli::lib::prune_sourcevanished_targets unavailable (older punk::mix::cli snapshot) - skipping sourcevanished prune for $modpod_layout"
}
}
}
if {$::punkboot::command in {bakehouse packages modules}} {
#consolidated /modules /modules_tclX folder used for target where X is tcl major version
#the make process will process for any _tclX not just the major version of the current interpreter
#default source module folders are at projectroot/src/modules and projectroot/src/modules_tclX (where X is tcl major version)
#There may be multiple other src module folders at same level (e.g folder not being other special-purpose folder and not matching name vendor* that contains at least one .tm file in its root)
set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot]
puts stdout "SOURCEMODULES: scanning [llength $source_module_folderlist] folders"
foreach src_module_dir $source_module_folderlist {
set mtail [file tail $src_module_dir]
if {[string match "modules_tcl*" $mtail]} {
set target_modules_base $projectroot/$mtail
} else {
set target_modules_base $projectroot/modules
}
file mkdir $target_modules_base
puts stderr "Processing source module dir: $src_module_dir"
set dirtail [file tail $src_module_dir]
#modules and associated files belonging to this package/app
set copied [punk::mix::cli::lib::build_modules_from_source_to_base $src_module_dir $target_modules_base -glob *.tm] ;#will only accept a glob ending in .tm
#set copied [list]
puts stdout "--------------------------"
puts stderr "Copied [llength $copied] tm modules from src/$dirtail to $target_modules_base "
puts stdout "--------------------------"
set overwrite "installedsourcechanged-targets"
#set overwrite "ALL-TARGETS"
puts stdout "MODULEFOLDER non_tm_files $src_module_dir - copying to $target_modules_base (if source file changed)"
set resultdict [punkcheck::install_non_tm_files $src_module_dir $target_modules_base\
-installer make.tcl\
-overwrite $overwrite\
-exclude-paths {README.md **/AGENTS.md AGENTS.md}\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
}
if {$::punkboot::command in {bakehouse packages modules libs}} {
set installername "make.tcl"
# ----------------------------------------
if {[punk::repo::is_fossil_root $projectroot]} {
set config [dict create {*}{
-make-step configure_fossil
}]
#----------
set installer [punkcheck::installtrack new $installername $projectroot/.punkcheck]
$installer set_source_target $projectroot $projectroot
set event [$installer start_event $config]
$event targetset_init VIRTUAL fossil_settings_mainmenu ;#VIRTUAL - since there is no actual target file
set menufile $projectroot/.fossil-custom/mainmenu
$event targetset_addsource $menufile
#----------
if {\
[llength [dict get [$event targetset_source_changes] changed]]\
} {
$event targetset_started
# -- --- --- --- --- ---
puts stdout "Configuring fossil setting: mainmenu from: $menufile"
if {[catch {
set fd [open $menufile r]
fconfigure $fd -translation binary
set data [read $fd]
close $fd
exec fossil settings mainmenu $data
} errM]} {
$event targetset_end FAILED -note "fossil update failed: $errM"
} else {
$event targetset_end OK
}
# -- --- --- --- --- ---
} else {
puts stderr "."
$event targetset_end SKIPPED
}
$event end
$event destroy
$installer destroy
}
}
#review
set installername "make.tcl"
if {$::punkboot::command ni {bakehouse bake bin}} {
#command = packages/modules/libs/vfslibs - stops before kit assembly
puts stdout "vfs folders not checked"
puts stdout " - use 'make.tcl vfscommonupdate' to promote built modules into the base vfs folder (promotion gate - commit for provenance)"
puts stdout " - use 'make.tcl bake' to build executable kits/zipkits from the vfs folders if you have runtimes installed"
puts stdout " Note that without the vfscommonupdate step, 'make.tcl bake' will include any manual changes in the *custom* vfs folders but"
puts stdout " without the latest built modules."
puts stdout " calling 'builtexename(.exe) dev' will allow testing of built modules before they are baked into the kits/zipkits via 'vfscommonupdate' then 'bake'"
puts stdout " - consumer full path from a clean checkout: 'make.tcl bakehouse'"
puts stdout "-done-"
exit 0
}
set buildfolder [punk::mix::cli::lib::get_build_workdir $sourcefolder]
if {$buildfolder ne "$sourcefolder/_build"} {
puts stderr "$sourcefolder/_build doesn't match the project buildfolder $buildfolder - check project filestructure"
puts stdout " -aborted- "
exit 2
}
if {$::punkboot::command eq "bin"} {
puts stdout "checking $sourcefolder/bin"
set resultdict [punkcheck::install $sourcefolder/bin $binfolder\
-overwrite synced-targets\
-installer "punkboot-bin"\
-progresschannel stdout\
]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
flush stdout
}
#find runtimes
#set rtfolder $sourcefolder/runtime
#AAA
#G-122: the runtime store is addressed by TARGET platform, not by the driving
#tclsh's personality. $rt_default_target is this host's default target (a
#cygwin-family host targets win32; macOS collapses to the universal 'macosx'
#tier) and $rtfolder is that target's store. mapvfs.config entries may declare
#their own target platform - those runtimes live in their own tier under $rtbase
#and are resolved through $rtfolder_of below.
set rt_default_target $::punkboot::target_platform
set rt_os_arch [punkboot::lib::platform_store_tier $rt_default_target]
set rtbase $binfolder/runtime
set rtfolder $rtbase/$rt_os_arch
set rt_exe_suffix [punkboot::lib::platform_exe_suffix $rt_default_target]
set rt_sourcefolder $sourcefolder/runtime ;#where our config lives
#G-122: derive the BUILDCOPY name from the runtime FILENAME rather than from the
#driving tclsh's platform. The copy is the same binary as its source, so it must
#keep the source's executable convention - an .exe stays an .exe whether a native
#windows tclsh, an msys/cygwin-runtime tclsh (platform 'unix', .exe files) or a
#cross-target host is driving the build.
#Mapping key for a runtime FILE name: the name as mapvfs.config spells it, i.e
#with a windows .exe suffix removed. Only .exe may be stripped - 'file rootname'
#would eat the last dotted segment of version-named runtimes such as tclsh9.0.5,
#which carry no suffix at all on non-windows targets (G-122).
proc ::punkboot::lib::runtime_mapkey {runtimefile} {
if {[string match -nocase *.exe $runtimefile]} {
return [string range $runtimefile 0 end-4]
}
return $runtimefile
}
proc ::punkboot::lib::runtime_buildcopyname {runtime} {
set rttail [file tail $runtime]
if {[string match -nocase *.exe $rttail]} {
return "[file rootname $rttail]_BUILDCOPY.exe"
}
return "${rttail}_BUILDCOPY"
}
#Local runtime-materialization staleness check (warn-only, no network). The kit
#wrap consumes the punk-runtime WORKING COPY (<root>[.exe]) - a developer may
#deliberately 'punk-runtime use' an older -r<N> artifact (e.g to exercise
#'list -remote' row marking) and forget to switch back, silently baking kits on
#a stale runtime (field incident 2026-07-25: punk9_beta wrapped an r1 runtime
#while r2 sat beside it - caught only by a piperepl test pin). Compares the
#working copy's beside-toml revision (G-103/G-117 metadata) against the highest
#-r<N> artifact revision present in the same folder. Pre-family runtimes (no
#toml) and direct -r<N> references stay silent; one warning per runtime per run.
#G-121: the comparison core lives in ::punkboot::lib::runtime_materialization_check,
#shared with the bakelist report's rtrev= note.
#G-122: run a command whose arguments must reach a NATIVE WINDOWS program
#verbatim. The msys2 runtime rewrites any argument that looks like an absolute
#posix path when it spawns a native windows executable, so 'taskkill /PID 1234'
#arrives as 'taskkill C:/msys64-root/PID 1234' - field-verified 2026-07-26: the
#pre-deploy process sweep found the running kit with tasklist and then could not
#kill it, failing the whole kit. MSYS2_ARG_CONV_EXCL=* is msys2's documented
#opt-out and is inert on every other host (real cygwin does not convert arguments
#at all), so one command spelling stays correct from every host personality.
proc ::punkboot::exec_nativeargs {cmdlist} {
set had [info exists ::env(MSYS2_ARG_CONV_EXCL)]
if {$had} {
set prev $::env(MSYS2_ARG_CONV_EXCL)
}
set ::env(MSYS2_ARG_CONV_EXCL) *
try {
return [exec {*}$cmdlist]
} finally {
if {$had} {
set ::env(MSYS2_ARG_CONV_EXCL) $prev
} else {
unset -nocomplain ::env(MSYS2_ARG_CONV_EXCL)
}
}
}
set ::punkboot::runtime_rev_warned [dict create]
proc ::punkboot::runtime_materialization_warning {rtfolder runtime_fullname} {
if {[dict exists $::punkboot::runtime_rev_warned $runtime_fullname]} {
return
}
dict set ::punkboot::runtime_rev_warned $runtime_fullname 1
set stale [punkboot::lib::runtime_materialization_check $rtfolder $runtime_fullname]
if {[dict size $stale]} {
set current_rev [dict get $stale current_rev]
set maxrev [dict get $stale maxrev]
set maxname [dict get $stale maxname]
::punkboot::print_build_warnings [list "runtime $runtime_fullname working copy is materialized from revision r$current_rev but $maxname (r$maxrev) is present beside it - kits wrapping this runtime get r$current_rev. To bake with r$maxrev: bin/punk-runtime.cmd use $maxname then re-run the bake"]
}
return
}
# -- --- --- --- --- --- --- --- --- ---
#load mapvfs.config file (if any) in runtime folder to map runtimes to vfs folders.
#build a dict keyed on runtime executable name.
#If no mapfile (or no mapfile entry for that runtime) - the runtime will be paired with a matching .vfs folder in src folder. e.g punk.exe to src/punk.vfs
#If vfs folders or runtime executables which are explicitly listed in the mapfile don't exist - warn on stderr - but continue. if such nonexistants found; prompt user for whether to continue or abort.
#G-121: parsing lives in ::punkboot::lib::mapvfs_parse - the shared model consumed here,
#by 'bakelist' and by the selective-bake name resolution (never the file format directly).
#G-122: parsed BEFORE runtime discovery, because the mapping is what says which
#store tiers this bake must look in - an entry declaring a target platform other
#than the host default addresses its own bin/runtime/<tier>.
set mapfile $rt_sourcefolder/mapvfs.config
set mapmodel [punkboot::lib::mapvfs_parse $mapfile $rtbase $sourcefolder $rt_default_target]
foreach warnline [dict get $mapmodel warnings] {
puts stderr $warnline
}
if {[llength [dict get $mapmodel configerrors]]} {
foreach errline [dict get $mapmodel configerrors] {
puts stderr $errline
}
exit 3
}
set runtime_vfs_map [dict get $mapmodel runtime_vfs_map]
set vfs_runtime_map [dict get $mapmodel vfs_runtime_map]
set runtime_target [dict get $mapmodel runtime_target]
set missing [dict get $mapmodel missing]
if {[llength $missing]} {
puts stderr "WARNING [llength $missing] missing items from $mapfile. (TODO - prompt user to continue/abort)"
foreach m $missing {
puts stderr " $m"
}
puts stderr "continuing..."
}
# -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --"
punk::lib::pdict runtime_vfs_map
puts "---------------------"
puts "-- vfs_runtime_map--"
punk::lib::pdict vfs_runtime_map
puts "---------------------"
# -- --- --- --- --- --- --- --- --- ---
#Runtime discovery. The default-target store is scanned wholesale (a runtime
#there needs no mapping entry - it can pair with a same-named .vfs folder);
#cross-target runtimes are only picked up when the mapping names them, since
#scanning every tier would pull in runtimes nothing asked to be built.
#$rtfolder_of resolves a discovered runtime FILE name to the store folder it
#came from (runtime_target_of gives its target platform) - every later store
#address, suffix and process-tooling decision goes through these rather than
#assuming the driving tclsh's platform (G-122).
set runtimes [list]
set rtfolder_of [dict create]
proc ::punkboot::lib::runtime_target_of {rtname} {
#target platform of a runtime name (unsuffixed), from the parsed mapping
upvar #0 runtime_target runtime_target rt_default_target rt_default_target
if {[info exists runtime_target] && [dict exists $runtime_target $rtname]} {
return [dict get $runtime_target $rtname]
}
return $rt_default_target
}
if {[file dirname [info nameofexecutable]] eq $rtfolder && [file isdirectory [info nameofexecutable]]} {
#info name will only appear to be a directory when the runtime is a tclkit that is mounted at the same path as the physical file.
#This is not a problem for zip based kits.
#fix so that we can find and use a runtime tclkit that is currently in use as the runtime that is running this script.
# - when the current runtime is using a runtime in the rtfolder that is a tclkit, it is mounted at the same path as the physical file and so appears to Tcl as if it's a directory.
# - use external filesystem tools to make a copy of the file
#(copy tooling is a HOST concern - the running executable is by definition a host binary)
if {$::punkboot::host_windows} {
#exec cmd /c copy [info nameofexecutable] $rtfolder/[file rootname [file tail [info nameofexecutable]]]_BUILDCOPY.exe
::punkboot::exec_nativeargs [list cmd /c copy [file nativename [info nameofexecutable]] [file nativename $rtfolder/[punkboot::lib::runtime_buildcopyname [info nameofexecutable]]]]
} else {
#exec cp [info nameofexecutable] $rtfolder/[file tail [info nameofexecutable]]_BUILDCOPY
exec cp [info nameofexecutable] $rtfolder/[punkboot::lib::runtime_buildcopyname [info nameofexecutable]]
}
#we need to add the base name of the current exe to the runtimes list because the next section will look for files in the runtime folder
#and won't find the mounted runtime since it's mounted as a directory.
lappend runtimes [file tail [info nameofexecutable]]
dict set rtfolder_of [file tail [info nameofexecutable]] $rtfolder
}
set rtfolder_files [glob -nocomplain -dir $rtfolder -types {f} -tail *]
set exclusions {.config .md .ico .txt .doc .pdf .htm .html} ;#we don't encourage other files in runtime folder aside from mapvfs.config - but lets ignore some common possibilities
lappend exclusions .zip .7z .pea .bz2 .tar .gz .tgz .z .xz ;#don't allow archives to directly be treated as runtimes - tolerate presence but require user to unpack or rename if they're to be used as runtimes
lappend exclusions .tail ;#result of running sdx mksplit on a kit - in theory the .head could be used - review/test
lappend exclusions .toml ;#G-103 runtime artifact metadata sits beside its runtime
foreach f $rtfolder_files {
if {[string match "*_BUILDCOPY*" $f]} {
continue
}
if {[string tolower [file extension $f]] in $exclusions} {
continue
}
if {$f ni $runtimes} {
lappend runtimes $f
dict set rtfolder_of $f $rtfolder
}
}
#cross-target runtimes named by the mapping (their own tier, their own suffix)
set cross_target_tiers [list]
dict for {_rtname _rttarget} $runtime_target {
if {$_rtname eq "-" || $_rttarget eq $rt_default_target} {
continue
}
set _tier [punkboot::lib::platform_store_tier $_rttarget]
set _dir $rtbase/$_tier
set _file $_rtname[punkboot::lib::platform_exe_suffix $_rttarget]
if {$_tier ni $cross_target_tiers} {
lappend cross_target_tiers $_tier
}
if {![file exists [file join $_dir $_file]]} {
continue ;#absent cross-target runtime already warned by the parse
}
if {[dict exists $rtfolder_of $_file]} {
puts stderr "WARNING: runtime file $_file is present in more than one store tier ([dict get $rtfolder_of $_file] and $_dir) - using the first found. Rename one of them to build both."
continue
}
lappend runtimes $_file
dict set rtfolder_of $_file $_dir
}
if {[llength $cross_target_tiers]} {
puts stdout "cross-target runtime tiers in use (mapvfs.config target platforms): [join $cross_target_tiers {, }]"
}
unset -nocomplain _rtname _rttarget _tier _dir _file
if {![llength $runtimes]} {
puts stderr "No executable runtimes found in $rtfolder - unable to build any .vfs folders into executables."
puts stderr "Add runtimes to $rtfolder if required"
if {![file isdirectory $rtfolder]} {
#same store-tier self-diagnosis as bakelist
puts stderr "NOTE: that runtime store folder does not exist. Default target '$rt_default_target' derives from THIS tclsh: tcl_platform(os)='$::tcl_platform(os)' tcl_platform(platform)='$::tcl_platform(platform)' -> host canon '$::punkboot::host_platform' -> target '$rt_default_target'."
puts stderr " Populate it with 'bin/punk-runtime.cmd' (or by hand), or declare a per-entry target platform in mapvfs.config for runtimes stored elsewhere."
}
#todo - don't exit - it is valid to use runtime of - to just build a .kit/.zipkit ?
exit 0
}
#G-121 selective bake: restrict processing to the runtimes the selected kits wrap -
#other runtimes get no BUILDCOPY refresh, no capability probe and no punkcheck events.
if {[llength $::punkboot::bake_selected_kitnames]} {
set runtimes [lmap _rtfile $runtimes {
#NOTE: only an .exe suffix may be stripped to recover the mapping key -
#'file rootname' would eat the last dotted version segment of names like
#tclsh9.0.5 (suffixless on non-windows targets).
set _rtkey [punkboot::lib::runtime_mapkey $_rtfile]
if {$_rtkey ni $::punkboot::bake_selected_runtimes} {
continue
}
set _rtfile
}]
unset -nocomplain _rtfile _rtkey
}
#previous have_sdx test location
#only test the runtime capabilities for runtimes that are actually in our map
#how can we do this for runtimes from other platforms?
#method1 try to mount as zip and kit - depends on current runtime to have mkzip - just because there is zip data doesn't mean the kit can mount it
#method2 analyze executable to determine if its for another platform - then ask user and save answers in a config file.?
#mthod3 qemu?
set runtime_caps [dict create]
foreach runtime [dict keys $runtime_vfs_map] {
if {[llength $::punkboot::bake_selected_kitnames] && $runtime ni $::punkboot::bake_selected_runtimes} {
continue ;#G-121 selective bake - probe only the runtimes being wrapped
}
set capscript {
set caps [dict create]
dict set caps patchlevel [info patchlevel]
if {[lsearch -index 1 [info loaded] tclkitpath] >=0} {
#for a bare kit that has had vfs removed (ie head made with sdx mksplit)
#we can't use package require starkit
dict set caps has_starkit 1
} else {
#fallback - review if necessary
if {![catch {
package require starkit
} errM]} {
dict set caps has_starkit 1
} else {
dict set caps has_starkit 0
}
}
#G-129: key zipfs capability on tcl::zipfs::mount - present in every zipfs
#generation including the androwish/undroidwish 8.6 backport, which has no
#tcl::zipfs::root. (This block previously rode a body-less 'if {![catch ..]}'
#that only worked because piped-stdin tclsh continues past command errors.)
if {[info commands tcl::zipfs::mount] ne ""} {
dict set caps has_zipfs 1
} else {
dict set caps has_zipfs 0
}
if {![catch {
package require cookfs
} errM]} {
dict set caps has_cookfs 1
} else {
dict set caps has_cookfs 0
}
puts -nonewline stdout $caps
exit 0
}
#G-122: address the runtime in ITS target's store tier, with ITS target's
#executable suffix. (Before the split this probed a suffixless name in the
#host-derived folder, so on windows every runtime silently reported
#find-fail and no capability was ever learned.)
set rt_target [punkboot::lib::runtime_target_of $runtime]
set rt_dir $rtbase/[punkboot::lib::platform_store_tier $rt_target]
set rt_file $runtime[punkboot::lib::platform_exe_suffix $rt_target]
if {![file exists $rt_dir/$rt_file]} {
dict set runtime_caps $runtime exitcode -1 error "find-fail $rt_dir/$rt_file"
continue
}
if {[punkboot::lib::platform_process_family $rt_target] ne [punkboot::lib::platform_process_family $::punkboot::host_platform]} {
#cross-target runtime: this host cannot execute it, so its capabilities
#stay unknown (the kit machinery falls back to trying the configured type)
dict set runtime_caps $runtime exitcode -1 error "cross-target ($rt_target) - not executable on this host"
continue
}
#invoke can fail if runtime not an executable file for the current platform
if {[file type $rt_dir/$rt_file] eq "directory"} {
#assume it's a mounted tclkit (because tcl kits mount in same place as their underlying path and mask the executable as a directory)
#use the BUILDCOPY created above - REVIEW
set useruntime [punkboot::lib::runtime_buildcopyname $rt_file]
} else {
set useruntime $rt_file
}
if {![catch {
lassign [punk::lib::invoke [list $rt_dir/$useruntime <<$capscript]] stdout stderr exitcode
} errM]} {
if {$exitcode == 0} {
dict set runtime_caps $runtime $stdout
}
dict set runtime_caps $runtime exitcode $exitcode
} else {
dict set runtime_caps $runtime exitcode -1 error "launch-fail"
}
}
puts stdout "Runtime capabilities:"
punk::lib::pdict runtime_caps
set vfs_tails [glob -nocomplain -dir $sourcefolder/vfs -types d -tail *.vfs]
#add any extra .vfs folders found in runtime/mapvfs.config file (e.g myotherruntimes/something.vfs)
dict for {vfstail -} $vfs_runtime_map {
if {$vfstail ni $vfs_tails} {
lappend vfs_tails $vfstail
}
}
#G-121 selective bake: only the selected kits' vfs folders get checked/checksummed -
#other vfs folders' punkcheck build events never fire.
if {[llength $::punkboot::bake_selected_kitnames]} {
set vfs_tails [lmap _vt $vfs_tails {
if {$_vt ni $::punkboot::bake_selected_vfs} {
continue
}
set _vt
}]
unset -nocomplain _vt
}
if {![llength $vfs_tails]} {
puts stdout "No .vfs folders found at '$sourcefolder/vfs' - no kits to build"
puts stdout " -done- "
exit 0
}
set vfs_folder_changes [dict create] ;#cache whether each .vfs folder has changes so we don't re-run tests if building from same .vfs with multiple runtime executables
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#make build copy for all runtimes - not just those in the map - because even without a mapvfs.config file entry we build an exe for a runtime that matches .vfs folder name - REVIEW.
foreach runtimefile $runtimes {
#runtimefile e.g tclkit86bi.exe for a win32 target, tclkit86bi for a posix one
#sdx *may* be pointed to use the runtime we use to build the kit, or the user may manually use this runtime if they don't have tclsh
#sdx will complain if the same runtime is used for the shell as is used in the -runtime argument - so we make a copy (REVIEW)
#if {![file exists $buildfolder/buildruntime.exe]} {
# file copy $rtfolder/$runtimefile $buildfolder/buildruntime.exe
#}
#G-122: each runtime is read from the tier its target platform names, not
#from one host-derived folder. Build copies keep the flat build_<file> name -
#the mapping cannot hold one runtime name in two tiers, so they cannot collide.
set rt_dir [dict get $rtfolder_of $runtimefile]
if {![file exists $rt_dir/$runtimefile]} {
puts stderr " >> skipping $runtimefile not present in $rt_dir"
continue
}
if {[file type $rt_dir/$runtimefile] eq "directory"} {
#assume it's a mounted tclkit (because tcl kits mount in same place as their underlying path and mask the executable)
#use the BUILDCOPY created above - REVIEW
set useruntimefile [punkboot::lib::runtime_buildcopyname $runtimefile]
} else {
set useruntimefile $runtimefile
}
set basedir $buildfolder
set config [dict create {*}{
-make-step copy_runtime
}]
#----------
set installer [punkcheck::installtrack new $installername $basedir/.punkcheck]
$installer set_source_target $rt_dir $buildfolder
set event [$installer start_event $config]
$event targetset_init INSTALL $buildfolder/build_$runtimefile
#$event targetset_addsource $rt_dir/$runtimefile
$event targetset_addsource $rt_dir/$useruntimefile ;#possibly the _BUILDCOPY in the runtime folder (created for when mounted in current executable as a tclkit)
$event targetset_addsource $buildfolder/build_$runtimefile ;#self as source for change detection
#----------
#set changed_unchanged [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $file_record body] end]]
if {\
[llength [dict get [$event targetset_source_changes] changed]]\
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]]\
} {
$event targetset_started
# -- --- --- --- --- ---
#This is the full runtime - *possibly* with some sort of vfs attached.
puts stdout "Copying runtime (as is) from $rt_dir/$useruntimefile to $buildfolder/build_$runtimefile"
if {[catch {
file copy -force $rt_dir/$useruntimefile $buildfolder/build_$runtimefile ;#becomes building_runtime
} errM]} {
puts stderr " >> copy runtime to $buildfolder/build_$runtimefile FAILED"
$event targetset_end FAILED
} else {
$event targetset_end OK
}
# -- --- --- --- --- ---
} else {
puts stderr "unchanged: $runtimefile"
$event targetset_end SKIPPED
}
$event end
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set have_sdx 1
set sdxpath [auto_execok $binfolder/sdx]
if {$sdxpath eq ""} {
set sdxpath [auto_execok [file dirname [info nameofexecutable]]/sdx]
if {$sdxpath eq ""} {
#last resort - look on path
set sdxpath [auto_execok sdx]
}
if {$sdxpath eq ""} {
#last resorts - a tclkit and sdx.kit file
if {[file exists $binfolder/sdx.kit]} {
set tclkitpath [auto_execok $binfolder/tclkit]
if {$tclkitpath eq ""} {
set tclkitpath [auto_execok tclkit]
}
if {$tclkitpath ne ""} {
set sdxpath [list {*}$tclkitpath $binfolder/sdx.kit]
} else {
#see if the runtime (or any runtime *for current platform*) has tclkit in the name or has_starkit(?) and use that
#todo - review
#picking first found for now - fix
#G-122: only a runtime this HOST can execute can drive sdx - the
#capability probe already skipped cross-target runtimes, so a
#has_starkit record means the runtime ran here.
dict for {rtname rtprops} $runtime_caps {
if {[dict exists $rtprops has_starkit] && [dict get $rtprops has_starkit]} {
set _rt_target [punkboot::lib::runtime_target_of $rtname]
set testpath $rtbase/[punkboot::lib::platform_store_tier $_rt_target]/$rtname[punkboot::lib::platform_exe_suffix $_rt_target]
if {[file exists $testpath]} {
if {[file type $testpath] eq "directory"} {
set alt_tclkitpath [file dirname $testpath]/[punkboot::lib::runtime_buildcopyname $testpath]
} else {
set alt_tclkitpath $testpath
}
if {[file exists $alt_tclkitpath]} {
set sdxpath [list {*}$alt_tclkitpath $binfolder/sdx.kit]
break
}
}
}
}
}
}
}
if {$sdxpath eq "" || [catch {exec {*}$sdxpath help} errM]} {
puts stderr "FAILED to find usable sdx command or tclkit executable with sdx.bat"
puts stderr "If tclkit-based runtimes are required - check that sdx executable is in bin folder of project or in same folder as tcl/punk executable or on path"
puts stderr "This is not a problem if tcl8.7/tcl9+ kits using the preferred method 'zipfs' are to be used, or if cookfs based kits are to be used."
puts stderr "err: $errM"
#exit 1
set have_sdx 0
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set failed_kits [list]
set installed_kits [list]
set skipped_kits [list]
set skipped_kit_installs [list]
proc ::make_file_traversal_error {args} {
error "file_traverse error: $args"
}
#fauxlink aware recursive copy of files and folders
#will follow fauxlinks with 'merge_over' tag, will copy other fauxlinks
proc merge_over {sourcedir targetdir {depth 0}} {
package require fileutil
package require fauxlink
set margin [string repeat " " [expr {$depth * 4}]]
set ver [package require fileutil::traverse]
puts stdout "${margin}using fileutil::traverse $ver\n[package ifneeded fileutil::traverse $ver]"
package require control
if {![file exists $sourcedir]} {
puts stderr "${margin}merge_over sourcedir '$sourcedir' not found"
return
}
if {![file exists $targetdir]} {
puts stderr "${margin}merge_over targetdir '$targetdir' not found - target folder must already exist"
return
}
puts stdout "${margin}merge vfs $sourcedir over $targetdir STARTING"
#The tails should be unique enough for clarity in progress emissions to stdout
set sourcename [file tail $sourcedir]
set targetname [file tail $targetdir]
set t [fileutil::traverse %AUTO% $sourcedir -errorcmd ::make_file_traversal_error]
set last_type "-"
$t foreach file_or_dir {
set relpath [fileutil::stripPath $sourcedir $file_or_dir]
set target [file join $targetdir $relpath]
set this_type [file type $file_or_dir]
switch -exact -- $this_type {
directory {
if {$last_type ne "directory"} {
puts -nonewline stdout \n
}
if {![file exists $target]} {
#puts stdout "-- mkdir $target"
puts stdout "${margin}$sourcename -> $targetname mkdir $relpath"
#puts stdout "calling: file mkdir $target"
#note - file mkdir can fail on vfs mounts with non-existant intermediate paths.
#e.g if mount is at: //cookfstemp:/subpath/file.exe
#if mounted lower, e.g //cookfstemp:/file.exe it works
#todo - determine where the bug lies - submit ticket?
file mkdir $target
file mtime $target [file mtime $file_or_dir]
} else {
puts stdout "${margin}$sourcename -> $targetname existing dir $relpath"
}
}
file {
if {[file extension $file_or_dir] in {.fxlnk .fauxlink}} {
puts stdout "fauxlink: $file_or_dir"
flush stdout
if {[catch {
puts stdout ">";flush stdout
set linkinfo [fauxlink::resolve $file_or_dir]
} errM]} {
puts stdout ">>";flush stdout
puts stdout "${margin}--->fauxlink::resolve error\n $errM"
flush stdout
error $errM
}
puts stdout ">>>";flush stdout
puts stdout "--- '$linkinfo'"
flush stdout
set flinktags [dict get $linkinfo tags]
puts stdout "fauxlink tags: $flinktags"
flush stdout
if {"punk::boot,merge_over" in $flinktags} {
puts stdout "fauxlink got correct tag from $flinktags"
flush stdout
set linktarget [dict get $linkinfo targetpath]
if {[file pathtype $linktarget] eq "relative"} {
#fauxlink targets are link-location-relative (symlink semantics -
#the fauxlink module doc's 'file in parent dir' example). Same as
#the old sourcedir-relative resolution for the historical
#root-level links; differs for nested ones (G-129 app/main.tcl).
set actualsource [file join [file dirname $file_or_dir] $linktarget]
} else {
set actualsource $linktarget
}
set name [dict get $linkinfo name] ;#name the linked file will become
set aliased_file_or_dir [file join [file dirname $file_or_dir] $name]
set relpath [fileutil::stripPath $sourcedir $aliased_file_or_dir]
set target [file join $targetdir $relpath]
if {[file type $actualsource] eq "file"} {
#fauxlink linktarget (source data) is a file
puts -nonewline stdout "[punkboot::sgr 32]<fxlnk.targetfor.${name}>[punkboot::sgr]"
puts "file copy -force $actualsource $target"
file copy -force $actualsource $target
} else {
#fauxlink linktarget (source data) is a folder
puts stdout "${margin}RECURSING merge_over for link-target $actualsource due to fauxlink:[file tail $file_or_dir]"
#merge_over initial target dir must exist - use file mkdir to ensure
file mkdir $target
puts stdout "merge_over $actualsource $target [expr {$depth + 1}]"
merge_over $actualsource $target [expr {$depth + 1}]
}
} else {
puts stdout "fauxlink tag not matched"
flush stdout
#tag not targetted at us - just copy the fauxlink as an ordinary file
puts -nonewline stdout "<fxlnk>"
file copy -force $file_or_dir $target
}
} else {
puts -nonewline stdout "."
if {[file exists $target]} {
puts stderr "Warning: merge_over is overwriting $target"
}
file copy -force $file_or_dir $target
}
}
default {
puts stderr "${margin}merge vfs $sourcedir !!! unhandled file type $this_type !!!"
}
}
set last_type $this_type
}
$t destroy
puts stdout "\n${margin}merge vfs $sourcedir over $targetdir done."
}
#Startup-script presence check for a .vfs source folder about to be built into a kit.
#A kit's boot entry is a root-level main.tcl - either an actual file, or a root-level fauxlink
#resolving to the name main.tcl whose target exists and is a .tcl file (materialised into the
#build copy by the merge_over fauxlink handling above).
#Returns an empty string when a startup script is present, otherwise warning text.
#A kit without a startup script is legal (e.g a bare runtime + payload) - callers warn and
#continue rather than aborting.
proc vfs_startup_script_warning {vfsfolder} {
if {[file isfile [file join $vfsfolder main.tcl]]} {
return ""
}
package require fauxlink
set detail ""
foreach link [glob -nocomplain -dir $vfsfolder -types f *.fxlnk *.fauxlink] {
if {[catch {fauxlink::resolve $link} linkinfo]} {
append detail "; unresolvable fauxlink: [file tail $link]"
continue
}
if {[dict get $linkinfo name] ne "main.tcl"} {
continue
}
set linktarget [dict get $linkinfo targetpath]
if {[file pathtype $linktarget] eq "relative"} {
set linktarget [file join $vfsfolder $linktarget]
}
if {[file isfile $linktarget]} {
if {[string tolower [file extension $linktarget]] eq ".tcl"} {
return ""
}
append detail "; main.tcl fauxlink target '$linktarget' is not a .tcl file"
} else {
append detail "; main.tcl fauxlink target '$linktarget' does not exist"
}
}
return "vfs folder $vfsfolder has NO STARTUP SCRIPT: no root main.tcl and no root fauxlink resolving to main.tcl with an existing .tcl target - kits built from it will have no boot script (build proceeding anyway)$detail"
}
#Cat-style zipkit assembly: a raw (vfs-free) runtime followed by a freshly built
#zip, concatenated. This is the zipfs-less assembly path for BOTH zip-type kits
#(G-122): Tcl's zipfs locates an image by scanning back from the END of the file
#and reads the central directory with ARCHIVE-START-RELATIVE offsets, so a plain
#concatenation mounts. 'zipfs mkimg's file-relative offset rewrite is one
#convention, not a mounting requirement - the zipcat kit type is the in-repo
#proof, and this lets a driving tcl with no zipfs at all (any 8.6) assemble zip
#kits. The zip itself is written by tcl::zipfs::mkzip when the driving tcl has
#it, else by punk::zip::mkzip (pure Tcl).
#Returns the number of zip bytes appended.
proc ::punkboot::assemble_zipcat_image {raw_runtime wrapvfs outfile zipfile} {
file copy -force $raw_runtime $outfile
#runtime in runtime folder may not have write perm set - ensure the copy does as we need to append
catch {exec chmod +w $outfile}
file delete $zipfile
if {[info commands ::tcl::zipfs] ne ""} {
puts stdout "tcl::zipfs::mkzip $zipfile $wrapvfs $wrapvfs"
::tcl::zipfs::mkzip $zipfile $wrapvfs $wrapvfs
} else {
puts stdout "punk::zip::mkzip -directory $wrapvfs -base $wrapvfs $zipfile *"
package require punk::zip
punk::zip::mkzip -directory $wrapvfs -base $wrapvfs $zipfile *
}
puts stderr "concatenating zip to executable.."
set fdout [open $outfile a]
chan conf $fdout -translation binary
puts stderr "runtime bytes: [tell $fdout]"
set fdzip [open $zipfile r]
chan conf $fdzip -translation binary
set zipbytes [fcopy $fdzip $fdout]
close $fdzip
puts stderr "zip bytes: $zipbytes"
puts stderr "exezip bytes: [tell $fdout]"
close $fdout
return $zipbytes
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#G-057 kit icon step. Every built kit gets a <kitname>.resources.toml sidecar
#recording the build-time icon choice (default src/runtime/punkshell.ico,
#overridable by a root-level punkshell.ico in the kit's own custom .vfs folder,
#consulted PRE-merge so the _vfscommon copy never reads as an override), and
#win32-target kits get that icon embedded as PE RT_ICON/RT_GROUP_ICON resources
#when this host can write them. Two mechanisms share one semantic (delete ALL
#icon/group entries, write the .ico images as ids 1..N under the first
#pre-existing group's name+lang - idempotent by construction, parity recorded
#in the G-128 detail file): the vendored punkres portable stamper (G-128,
#src/tools/punkres, built by 'make.tcl tool build punkres') is selected when
#bin/punkres(.exe) exists and works from ANY build host; otherwise the twapi
#arm (tcl-sfe sfe-0.2.tm ReplaceIconInStub lineage; Ashok P. Nadkarni) serves
#windows hosts with nothing built. Ordering is stub-first either way: a per-kit
#copy of the payload-free raw runtime prefix is stamped BEFORE any payload is
#appended (punkres could also stamp post-hoc - the bake keeps stub-first so
#both arms stay interchangeable). kit_icon_process is the single internal
#entry point - mechanism selection lives inside it. Non-PE targets skip as NOT
#APPLICABLE; a win32 target on an incapable host skips with a distinct notice;
#both still write the sidecar.
#Decisions and skip taxonomy: goals G-057 detail file. Sidecar format doc:
#bin/AGENTS.md.
#sha256 is self-contained (same algorithm as src/assets/logo/make-ico.tcl and
#scriptlib/developer/assetorigin_check.tcl - each stays standalone: make.tcl
#must not depend on scriptlib, and this step must not depend on bootsupport
#freshness; bootsupport carries only sha1/md5). Memoized per path per run.
namespace eval ::punkboot::kiticon {
variable sha256_cache
if {![info exists sha256_cache]} {set sha256_cache [dict create]}
variable twapi_state ""
variable punkres_state ""
variable K {
0x428a2f98 0x71374491 0xb5c0fbcf 0xe9b5dba5 0x3956c25b 0x59f111f1 0x923f82a4 0xab1c5ed5
0xd807aa98 0x12835b01 0x243185be 0x550c7dc3 0x72be5d74 0x80deb1fe 0x9bdc06a7 0xc19bf174
0xe49b69c1 0xefbe4786 0x0fc19dc6 0x240ca1cc 0x2de92c6f 0x4a7484aa 0x5cb0a9dc 0x76f988da
0x983e5152 0xa831c66d 0xb00327c8 0xbf597fc7 0xc6e00bf3 0xd5a79147 0x06ca6351 0x14292967
0x27b70a85 0x2e1b2138 0x4d2c6dfc 0x53380d13 0x650a7354 0x766a0abb 0x81c2c92e 0x92722c85
0xa2bfe8a1 0xa81a664b 0xc24b8b70 0xc76c51a3 0xd192e819 0xd6990624 0xf40e3585 0x106aa070
0x19a4c116 0x1e376c08 0x2748774c 0x34b0bcb5 0x391c0cb3 0x4ed8aa4a 0x5b9cca4f 0x682e6ff3
0x748f82ee 0x78a5636f 0x84c87814 0x8cc70208 0x90befffa 0xa4506ceb 0xbef9a3f7 0xc67178f2
}
}
proc ::punkboot::kiticon::sha256_data {data} {
variable K
set bitlen [expr {wide([string length $data]) * 8}]
append data \x80
set pad [expr {(56 - [string length $data] % 64 + 64) % 64}]
append data [string repeat \x00 $pad] [binary format W $bitlen]
set h0 0x6a09e667; set h1 0xbb67ae85; set h2 0x3c6ef372; set h3 0xa54ff53a
set h4 0x510e527f; set h5 0x9b05688c; set h6 0x1f83d9ab; set h7 0x5be0cd19
set n [string length $data]
for {set off 0} {$off < $n} {incr off 64} {
binary scan [string range $data $off [expr {$off + 63}]] Iu16 w
for {set t 16} {$t < 64} {incr t} {
set x [lindex $w [expr {$t - 15}]]
set s0 [expr {((($x >> 7) | ($x << 25)) ^ (($x >> 18) | ($x << 14)) ^ ($x >> 3)) & 0xffffffff}]
set x [lindex $w [expr {$t - 2}]]
set s1 [expr {((($x >> 17) | ($x << 15)) ^ (($x >> 19) | ($x << 13)) ^ ($x >> 10)) & 0xffffffff}]
lappend w [expr {([lindex $w [expr {$t - 16}]] + $s0 + [lindex $w [expr {$t - 7}]] + $s1) & 0xffffffff}]
}
set a $h0; set b $h1; set c $h2; set d $h3
set e $h4; set f $h5; set g $h6; set h $h7
for {set t 0} {$t < 64} {incr t} {
set S1 [expr {((($e >> 6) | ($e << 26)) ^ (($e >> 11) | ($e << 21)) ^ (($e >> 25) | ($e << 7))) & 0xffffffff}]
set ch [expr {(($e & $f) ^ (~$e & $g)) & 0xffffffff}]
set T1 [expr {($h + $S1 + $ch + [lindex $K $t] + [lindex $w $t]) & 0xffffffff}]
set S0 [expr {((($a >> 2) | ($a << 30)) ^ (($a >> 13) | ($a << 19)) ^ (($a >> 22) | ($a << 10))) & 0xffffffff}]
set maj [expr {($a & $b) ^ ($a & $c) ^ ($b & $c)}]
set T2 [expr {($S0 + $maj) & 0xffffffff}]
set h $g; set g $f; set f $e; set e [expr {($d + $T1) & 0xffffffff}]
set d $c; set c $b; set b $a; set a [expr {($T1 + $T2) & 0xffffffff}]
}
set h0 [expr {($h0 + $a) & 0xffffffff}]; set h1 [expr {($h1 + $b) & 0xffffffff}]
set h2 [expr {($h2 + $c) & 0xffffffff}]; set h3 [expr {($h3 + $d) & 0xffffffff}]
set h4 [expr {($h4 + $e) & 0xffffffff}]; set h5 [expr {($h5 + $f) & 0xffffffff}]
set h6 [expr {($h6 + $g) & 0xffffffff}]; set h7 [expr {($h7 + $h) & 0xffffffff}]
}
return [format %08x%08x%08x%08x%08x%08x%08x%08x $h0 $h1 $h2 $h3 $h4 $h5 $h6 $h7]
}
proc ::punkboot::kiticon::sha256_file {path} {
variable sha256_cache
set key [file normalize $path]
if {[dict exists $sha256_cache $key]} {
return [dict get $sha256_cache $key]
}
set f [open $path rb]
set data [read $f]
close $f
set hex [sha256_data $data]
dict set sha256_cache $key $hex
return $hex
}
proc ::punkboot::kiticon::toml_escape {s} {
return [string map {\\ \\\\ \" \\\"} $s]
}
#Tolerant subset reader for the chosen icon's G-135 assetorigin sidecar - lifts
#source/source_hash so the kit record reaches back to the SVG-derived master.
#Missing sidecar, unknown schema or malformed content simply yields no
#provenance fields (never an error).
proc ::punkboot::kiticon::assetorigin_read {assetpath} {
set sc $assetpath.assetorigin.toml
set out [dict create]
if {![file isfile $sc]} {
return $out
}
if {[catch {
set f [open $sc rb]
set raw [read $f]
close $f
}]} {
return $out
}
foreach line [split [encoding convertfrom utf-8 $raw] \n] {
set line [string trim [string map [list \r {}] $line]]
if {$line eq "" || [string index $line 0] eq "#"} continue
if {[string index $line 0] eq "\["} break
set eq [string first = $line]
if {$eq < 1} continue
set key [string trim [string range $line 0 [expr {$eq - 1}]]]
if {$key ni {schema source source_hash}} continue
set val [string trim [string range $line [expr {$eq + 1}] end]]
if {[string index $val 0] eq "\""} {
set parsed ""
set ok 0
set len [string length $val]
for {set i 1} {$i < $len} {incr i} {
set chr [string index $val $i]
if {$chr eq "\\"} {
incr i
append parsed [string index $val $i]
} elseif {$chr eq "\""} {
set ok 1
break
} else {
append parsed $chr
}
}
if {!$ok} continue
set val $parsed
} else {
set cmt [string first # $val]
if {$cmt >= 0} {
set val [string trim [string range $val 0 [expr {$cmt - 1}]]]
}
}
dict set out $key $val
}
if {![dict exists $out schema] || [dict get $out schema] ne "1"} {
return [dict create]
}
return $out
}
proc ::punkboot::kiticon::writefile_ifchanged {path content} {
if {[file exists $path]} {
set f [open $path rb]
set existing [read $f]
close $f
if {$existing eq $content} {
return unchanged
}
}
set f [open $path wb]
puts -nonewline $f $content
close $f
return written
}
proc ::punkboot::kiticon::copy_ifchanged {from to} {
if {![file isfile $from]} {
return absent
}
set f [open $from rb]
set fromdata [read $f]
close $f
if {[file exists $to]} {
set f [open $to rb]
set todata [read $f]
close $f
if {$todata eq $fromdata} {
return unchanged
}
}
file copy -force $from $to
return copied
}
#Memoized once per run: can this host's tclsh write PE resources? Returns
#{1 {}} or {0 reason} with the reason distinguishing cross-host from
#twapi-unavailable (the acceptance requires distinct notices).
proc ::punkboot::kiticon::twapi_available {} {
variable twapi_state
if {$twapi_state eq "ok"} {
return [list 1 {}]
}
if {$twapi_state ne ""} {
return [list 0 $twapi_state]
}
if {[punkboot::lib::platform_process_family $::punkboot::host_platform] ne "windows"} {
set twapi_state "cross-host: win32 target baked on a $::punkboot::host_platform host cannot run the twapi resource APIs (portable post-hoc stamping is the G-128 remedy)"
return [list 0 $twapi_state]
}
if {[catch {package require twapi_resource}] && [catch {package require twapi}]} {
set twapi_state "twapi resource APIs not loadable in this tclsh ([info nameofexecutable]) - the vendored twapi under vendorlib_tcl<N>/win32-x86_64 serves native windows tclsh builds"
return [list 0 $twapi_state]
}
if {![llength [info commands ::twapi::begin_resource_update]]} {
set twapi_state "twapi loaded but its resource-update APIs are absent"
return [list 0 $twapi_state]
}
set twapi_state ok
return [list 1 {}]
}
#Memoized once per run: locate the built punkres portable stamper (G-128).
#Returns {1 <exepath>} or {0 <reason>}. Presence of the binary IS the
#mechanism-selection signal: with no tool built the twapi arm and its skip
#taxonomy behave exactly as they did before G-128 (zig stays optional).
proc ::punkboot::kiticon::punkres_available {repo_root} {
variable punkres_state
if {$punkres_state ne ""} {
return $punkres_state
}
if {[punkboot::lib::platform_process_family $::punkboot::host_platform] eq "windows"} {
set exe $repo_root/bin/punkres.exe
} else {
set exe $repo_root/bin/punkres
}
if {[file isfile $exe]} {
set punkres_state [list 1 $exe]
} else {
set punkres_state [list 0 "portable stamper not present at $exe - 'tclsh src/make.tcl tool build punkres' builds it from vendored source (G-128)"]
}
return $punkres_state
}
#G-128 punkres arm: exec the vendored portable stamper on the payload-free stub
#copy. punkres itself deletes all icon/group entries, writes the images as ids
#1..N under the first pre-existing group's name+lang, and re-reads its own
#output (resources AND any overlay) before reporting success - equivalent
#resource content to the twapi arm from the same input (parity evidence in the
#G-128 detail file). Returns the number of images embedded; raises an error
#carrying punkres's output on any nonzero exit.
proc ::punkboot::kit_icon_embed_punkres {punkres_exe exepath icopath} {
set f [open $icopath rb]
set icondata [read $f]
close $f
binary scan $icondata ttt ico_reserved ico_type ico_count
if {$ico_reserved != 0 || $ico_type != 1} {
error "$icopath is not recognisable as a .ico file"
}
if {$ico_count == 0} {
error "no images in $icopath"
}
if {[catch {exec [file nativename $punkres_exe] set-icon [file nativename $exepath] [file nativename $icopath] 2>@1} output]} {
error "punkres set-icon failed: $output"
}
return $ico_count
}
#Replace RT_ICON (type 3) and RT_GROUP_ICON (type 14) in the PE at exepath with
#the images of icopath. Follows sfe-0.2.tm ReplaceIconInStub generalized: all
#existing icon/group entries (any name, any lang) are deleted and the new set
#written as ids 1..N under the first pre-existing group's name+lang (fallback
#name 1, lang 1033), in one resource-update transaction. Raises an error on
#failure (after -discard); returns the number of images embedded. The file at
#exepath must carry NO appended payload - a resource update rewrites the image.
proc ::punkboot::kit_icon_embed_twapi {exepath icopath} {
set f [open $icopath rb]
set icondata [read $f]
close $f
binary scan $icondata ttt ico_reserved ico_type ico_count
if {$ico_reserved != 0 || $ico_type != 1} {
error "$icopath is not recognisable as a .ico file"
}
if {$ico_count == 0} {
error "no images in $icopath"
}
set old_icons [list]
set old_groups [list]
set libh [twapi::load_library $exepath -datafile]
try {
set resources [twapi::extract_resources $libh]
foreach {restype var} {3 old_icons 14 old_groups} {
if {[dict exists $resources $restype]} {
foreach rname [dict keys [dict get $resources $restype]] {
foreach rlang [dict keys [dict get $resources $restype $rname]] {
lappend $var [list $rname $rlang]
}
}
}
}
} trap {TWAPI_WIN32 1812} {} {
#no resource section at all - nothing to enumerate
} finally {
twapi::free_library $libh
}
set group_name 1
set group_lang 1033
if {[llength $old_groups]} {
lassign [lindex $old_groups 0] group_name group_lang
}
set update_h [twapi::begin_resource_update $exepath]
try {
foreach entry $old_icons {
lassign $entry rname rlang
twapi::delete_resource $update_h 3 $rname $rlang
}
foreach entry $old_groups {
lassign $entry rname rlang
twapi::delete_resource $update_h 14 $rname $rlang
}
set grouphdr [binary format ttt 0 1 $ico_count]
for {set i 0} {$i < $ico_count} {incr i} {
#.ico ICONDIRENTRY is 16 bytes; GRPICONDIRENTRY is 14 - the trailing
#4-byte image offset becomes a 2-byte icon resource id. Raw width and
#height bytes are carried as-is (0 means 256 in both formats).
set off [expr {6 + 16 * $i}]
binary scan $icondata "@${off} cu cu cu cu tu tu nu nu" w h cc rsv planes bits bytesinres imgoff
set iconid [expr {$i + 1}]
append grouphdr [binary format "cu cu cu cu tu tu nu tu" $w $h $cc $rsv $planes $bits $bytesinres $iconid]
twapi::update_resource $update_h 3 $iconid $group_lang [string range $icondata $imgoff [expr {$imgoff + $bytesinres - 1}]]
}
twapi::update_resource $update_h 14 $group_name $group_lang $grouphdr
} on error {msg ropts} {
catch {twapi::end_resource_update $update_h -discard}
return -options $ropts $msg
}
twapi::end_resource_update $update_h
return $ico_count
}
#G-057 single internal entry point. Decides the kit's icon (override: root
#punkshell.ico in the kit's own custom .vfs folder, pre-merge; else the project
#default src/runtime/punkshell.ico), writes/refreshes the kit's
#<kitname>.resources.toml sidecar in the build folder, and - when the target
#has PE resources and this host can write them - stamps a per-kit copy of the
#payload-free raw runtime prefix. Returns {wrap_runtime sidecarpath}:
#wrap_runtime is the runtime prefix the assembly step must consume (the stamped
#copy when embedding happened, the untouched raw prefix otherwise).
proc ::punkboot::kit_icon_process {targetkit rt_target rtname kit_type sourcefolder vfstail raw_runtime buildfolder} {
set repo_root [file dirname $sourcefolder]
set override_icon $sourcefolder/vfs/$vfstail/punkshell.ico
if {[file isfile $override_icon]} {
set icon_origin override
set icon_path $override_icon
} else {
set icon_origin default
set icon_path $sourcefolder/runtime/punkshell.ico
}
set have_icon [file isfile $icon_path]
set embedding none
set status ""
set reason ""
if {![string match "win32-*" $rt_target]} {
set status not-applicable
set reason "target $rt_target has no PE resources"
} elseif {$rtname eq "-"} {
set status not-applicable
set reason "runtimeless .kit artifact has no PE container"
} elseif {$kit_type in {cookit cookfs}} {
set status unavailable
set reason "kit type $kit_type edits the payload in place inside the mounted runtime - no payload-free stub moment to stamp"
} elseif {!$have_icon} {
set status unavailable
set reason "icon file not found at $icon_path"
} elseif {$raw_runtime in {{} -} || ![file isfile $raw_runtime]} {
set status unavailable
set reason "extraction produced no raw runtime prefix to stamp"
} else {
#mechanism selection (G-128): the portable stamper when built, else the
#twapi arm; only when neither serves does the step skip - the combined
#reason names both gaps and the punkres build remedy
lassign [::punkboot::kiticon::punkres_available $repo_root] punkres_ok punkres_info
if {!$punkres_ok} {
lassign [::punkboot::kiticon::twapi_available] twapi_ok twapi_reason
if {!$twapi_ok} {
set status unavailable
set reason "$twapi_reason; $punkres_info"
}
}
}
set wrap_runtime $raw_runtime
if {$status eq ""} {
set stamped $buildfolder/iconed_$targetkit
file copy -force $raw_runtime $stamped
catch {exec chmod +w $stamped}
if {$punkres_ok} {
set embedding punkres
set embed_cmd [list ::punkboot::kit_icon_embed_punkres $punkres_info $stamped $icon_path]
} else {
set embedding twapi
set embed_cmd [list ::punkboot::kit_icon_embed_twapi $stamped $icon_path]
}
if {[catch $embed_cmd embed_result]} {
::punkboot::print_build_warnings [list "kit icon embedding FAILED for $targetkit ($icon_origin icon $icon_path via $embedding): $embed_result - kit keeps its runtime's own icon"]
set status failed
set reason $embed_result
catch {file delete $stamped}
} else {
set status embedded
set wrap_runtime $stamped
puts stdout " kit icon (G-057): embedded $icon_origin icon into $targetkit stub via $embedding ($embed_result images from [file tail $icon_path])"
}
} elseif {$status eq "not-applicable"} {
puts stdout " kit icon (G-057): embedding NOT APPLICABLE for $targetkit - $reason (sidecar still written)"
} else {
puts stdout " kit icon (G-057): embedding UNAVAILABLE for $targetkit - $reason (sidecar still written)"
}
set esc ::punkboot::kiticon::toml_escape
set lines [list]
lappend lines "# kit resource record (schema 1) for the kit artifact named by this file"
lappend lines "# with the .resources.toml suffix stripped. Emitted by the make.tcl bake"
lappend lines "# icon step (G-057). Optional and advisory; format: bin/AGENTS.md."
lappend lines "schema = 1"
lappend lines "kit = \"[$esc $targetkit]\""
lappend lines "target = \"[$esc $rt_target]\""
lappend lines "kit_type = \"[$esc $kit_type]\""
lappend lines "icon_origin = \"$icon_origin\""
lappend lines "icon_source = \"[$esc [punkcheck::lib::path_relative $repo_root $icon_path]]\""
if {$have_icon} {
lappend lines "icon_hash = \"sha256:[::punkboot::kiticon::sha256_file $icon_path]\""
set ao [::punkboot::kiticon::assetorigin_read $icon_path]
if {[dict exists $ao source]} {
lappend lines "icon_provenance_source = \"[$esc [dict get $ao source]]\""
}
if {[dict exists $ao source_hash]} {
lappend lines "icon_provenance_source_hash = \"[$esc [dict get $ao source_hash]]\""
}
}
lappend lines "embedding = \"$embedding\""
lappend lines "embedding_status = \"$status\""
lappend lines "embedding_reason = \"[$esc $reason]\""
set sidecar $buildfolder/$targetkit.resources.toml
::punkboot::kiticon::writefile_ifchanged $sidecar "[join $lines \n]\n"
return [list $wrap_runtime $sidecar]
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set startdir [pwd]
puts stdout "Found [llength $vfs_tails] .vfs folders - checking each for executables that may need to be built"
cd [file dirname $buildfolder]
#root folder mtime is insufficient for change detection. Tree mtime of folders only is a barely passable mechanism for vfs change detection in some circumstances - e.g if files added/removed but never edited in place
#a hash of full tree file & dir mtime may be more reasonable - but it remains to be seen if just tar & checksum is any/much slower.
#Simply rebuilding all the time may be close the speed of detecting change anyway - and almost certainly much faster when there is a change.
#Using first mtime encountered that is later than target is another option - but likely to be highly variable in speed. Last file in the tree could happen to be the latest, and this mechanism doesn't handle build on reversion to older source.
set exe_names_seen [list]
set path_cksum_cache [dict create]
dict set path_cksum_cache {*}[punk::mix::base::lib::get_relativecksum_from_base $basedir $sourcefolder/vfs/_vfscommon.vfs]
#
# loop over vfs_tails and for each one, loop over configured (or matching) runtimes - build with sdx or zipfs if source .vfs or source runtime exe has changed.
# we are using punkcheck to install result to buildfolder so we create a .punkcheck file at the target folder to store metadata.
# punkcheck allows us to not rely purely on timestamps (which may be unreliable)
#
foreach vfstail $vfs_tails {
set vfsname [file rootname $vfstail]
puts stdout " ------------------------------------"
puts stdout " checking vfs $sourcefolder/vfs/$vfstail for configured runtimes"
set skipped_vfs_build 0
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set basedir $buildfolder
set config [dict create {*}{
-make-step build_vfs
}]
#G-122: a runtime's filename and store tier come from ITS target platform.
#The '-' pseudo-runtime (unwrapped .kit output) carries no file at all.
set runtimes [list]
if {[dict exists $vfs_runtime_map $vfstail]} {
#set runtimes [dict get $vfs_runtime_map $vfstail]
#runtimes in vfs_runtime_map_vfs dict are unsuffixed (.exe stripped or was not present)
set applist [dict get $vfs_runtime_map $vfstail]
foreach rt_app $applist {
set rt [lindex $rt_app 0]
if {$rt eq "-"} {
#the '-' (runtime-less .kit) pseudo-runtime has never reached this
#list - both historical branches filtered it out - so the loop
#below's '-' handling is currently unreachable. Left as-is:
#enabling it is a separate, untested change.
continue
}
set rt_target [punkboot::lib::runtime_target_of $rt]
set rt_file $rt[punkboot::lib::platform_exe_suffix $rt_target]
if {[file exists $rtbase/[punkboot::lib::platform_store_tier $rt_target]/$rt_file]} {
lappend runtimes $rt_file
}
}
} else {
#only match this vfs to a correspondingly named runtime if there was no explicit entry for that runtime
#review - should this only be done if there are NO explicit entries? how does a user stop builds of unneeded exes that match without renaming files/folders?
#but conversely, adding an extra entry shouldn't stop default builds that used to run..
set matchrt [file rootname [file tail $vfstail]] ;#e.g project.vfs -> project
if {![dict exists $runtime_vfs_map $matchrt]} {
#unmapped: the default-target store is the only place a name-match is looked for
if {[file exists $rtfolder/$matchrt$rt_exe_suffix]} {
lappend runtimes $matchrt$rt_exe_suffix
}
}
}
#assert $runtimes is a list of runtime filenames as they exist in their target's store tier
#(suffixed with .exe for windows-family targets, whether or not mapvfs.config spelled it that way)
puts " vfs: $vfstail runtimes to process ([llength $runtimes]): $runtimes"
if {[llength $runtimes]} {
#only check startup script for .vfs folders that will actually be built against a runtime
#(e.g _vfscommon.vfs is a merge overlay with no runtime mapping and legitimately has no main.tcl)
set startup_warning [vfs_startup_script_warning $sourcefolder/vfs/$vfstail]
if {$startup_warning ne ""} {
::punkboot::print_build_warnings [list $startup_warning]
}
}
#todo - non kit based - zipkit?
# $runtimes may now include a dash entry "-" (from mapvfs.config file)
foreach runtime_fullname $runtimes {
set rtname [punkboot::lib::runtime_mapkey $runtime_fullname]
if {[llength $::punkboot::bake_selected_kitnames] && $rtname ni $::punkboot::bake_selected_runtimes} {
continue ;#G-121 selective bake - no requested kit wraps this runtime
}
#G-122: everything this iteration emits is keyed by the runtime's TARGET
set rt_target [punkboot::lib::runtime_target_of $rtname]
set rt_tierdir $rtbase/[punkboot::lib::platform_store_tier $rt_target]
set rt_suffix [punkboot::lib::platform_exe_suffix $rt_target]
#rtname of "-" indicates build a kit without a runtime
if {$runtime_fullname ne "-"} {
::punkboot::runtime_materialization_warning $rt_tierdir $runtime_fullname
}
#first configured runtime will be the one to use the same name as .vfs folder for output executable. Additional runtimes on this .vfs will need to suffix the runtime name to disambiguate.
#review: This mechanism may not be great for multiplatform builds ? We may be better off consistently combining vfsname and rtname and letting a later platform-specific step choose ones to install in bin with simpler names.
set targetkits [list]
if {[dict exists $runtime_vfs_map $rtname]} {
set applist [dict get $runtime_vfs_map $rtname]
foreach vfs_app $applist {
#5th element = G-133 smoke-require package list ("" when undeclared)
lassign $vfs_app configured_vfs appname target_kit_type - kit_smokerequires
if {$configured_vfs ne $vfstail} {
continue
}
if {$appname eq ""} {
set appname $vfsname
}
if {$target_kit_type eq ""} {
set target_kit_type "kit" ;#review - we should probably move determining target_kit_type from that of source runtime, and if none, defaulting to zip (zipkit?)
}
if {$rtname eq "-"} {
set targetkit $appname.kit
} else {
set targetkit ${appname}$rt_suffix
if {$targetkit in $exe_names_seen} {
#duplicate appname configured?
#todo - consider creating as ${appname}(2) etc?
puts stderr "targetkit: $targetkit already seen - using name ${appname}_$rtname"
set targetkit ${appname}_$rtname
}
}
lappend exe_names_seen $targetkit
lappend targetkits [list $targetkit $target_kit_type $kit_smokerequires]
}
}
puts stdout " vfs: $vfstail runtime: $rtname targetkits: $targetkits"
foreach targetkit_info $targetkits {
if {[llength $::punkboot::bake_selected_kitnames] && [lindex $targetkit_info 0] ni $::punkboot::bake_selected_targetkits} {
continue ;#G-121 selective bake - not a requested kit output
}
puts stdout " processing targetkit: $targetkit_info"
lassign $targetkit_info targetkit target_kit_type kit_smokerequires
#Self-build guard: never process the kit whose deployed executable is running this
#build - the process sweep below would kill this very process, and the deploy step
#cannot replace a running image anyway. Informational/update subcommands are
#unaffected (they exit before the kit machinery), so driving make.tcl from a built
#punk executable remains supported for everything except rebuilding that executable.
#(a HOST filesystem comparison - case rules follow the host, not the target)
set self_exe [file normalize [info nameofexecutable]]
set self_deploy_target [file normalize $binfolder/$targetkit]
if {$::punkboot::host_windows} {
set is_self_build [string equal -nocase $self_exe $self_deploy_target]
} else {
set is_self_build [string equal $self_exe $self_deploy_target]
}
if {$is_self_build} {
puts stderr "SKIPPING kit $targetkit - its deployed executable is the one running this build ($self_exe)"
puts stderr " Rerun 'make.tcl $::punkboot::command' under tclsh or a different built kit to rebuild $targetkit."
lappend skipped_kits [list kit $targetkit reason "deployed executable is running this build"]
continue
}
# -- ----------
set vfs_installer [punkcheck::installtrack new $installername $basedir/.punkcheck]
$vfs_installer set_source_target $sourcefolder $buildfolder
set vfs_event [$vfs_installer start_event {-make-step build_vfs}]
$vfs_event targetset_init INSTALL $buildfolder/$targetkit
set relvfs [punkcheck::lib::path_relative $basedir $sourcefolder/vfs/$vfstail]
if {![dict exists $path_cksum_cache $relvfs]} {
#e.g ../vfs/punk87.vfs {cksum xxxx cksum_all_opts {-cksum_content 1 ... -cksum_algorithm sha1}}
dict set path_cksum_cache {*}[punk::mix::base::lib::get_relativecksum_from_base $basedir $sourcefolder/vfs/$vfstail]
}
$vfs_event targetset_cksumcache_set $path_cksum_cache ;#cached cksum entries for .vfs folder
$vfs_event targetset_addsource $sourcefolder/vfs/_config ;#some files linked via fauxlink - need to detect change
$vfs_event targetset_addsource $sourcefolder/vfs/_vfscommon.vfs
$vfs_event targetset_addsource $sourcefolder/vfs/$vfstail
if {[file isfile $sourcefolder/runtime/punkshell.ico]} {
#G-057: the default kit icon is a build input - a changed icon rebuilds
#kits (an override icon lives inside the .vfs folder, already a source)
$vfs_event targetset_addsource $sourcefolder/runtime/punkshell.ico
}
if {$rtname ne "-"} {
set building_runtime $buildfolder/build_$runtime_fullname ;#working copy of runtime executable - (possibly with kit/zipfs/cookfs etc attached!)
$vfs_event targetset_addsource $building_runtime
set raw_runtime "" ;#building runtime with vfs (zip,kit,cookfs etc stripped)
} else {
set building_runtime "-" ;#REVIEW
set raw_runtime "-"
}
# -- ----------
set changed_unchanged [$vfs_event targetset_source_changes]
set vfs_or_runtime_changed [expr {[llength [dict get $changed_unchanged changed]] || [llength [$vfs_event get_targets_exist]] < [llength [$vfs_event get_targets]]}]
if {$vfs_or_runtime_changed} {
#source .vfs folder has changes
$vfs_event targetset_started
# -- --- --- --- --- ---
if {[file exists $buildfolder/$vfsname.new]} {
puts stderr "deleting existing $buildfolder/$vfsname.new"
file delete $buildfolder/$vfsname.new
}
package require fileutil
package require fileutil::traverse
package require control
#keep this a simple name - bin/punk script calls into src/_build/exename.vfs/main.tcl
set targetvfs $buildfolder/$targetkit.vfs
file delete -force $targetvfs
set extraction_done 0
#we switch on the target_kit_type. we could switch on source_kit_type..allowing extraction from one type but writing to another?
#it usually won't make sense to try to convert a runtime kit type to another - unless the runtime happens to support multiple types -
# - but which location would main.tcl be run from?
#todo - check runtime's 'kit_type' and warn/disallow.
#to consider: - allow specifying runtime kits as if they are vfs folders in the normal xxx.vfs list - and autodetect and extract
#would need to detect UPX, cookfs,zipfs,tclkit
set rtmountpoint ""
#Test the capability VALUE, not just its presence: a probe that ran
#reports has_starkit/has_cookfs 0 for a plain zipfs runtime, and
#trying to unwrap such a runtime as a kit ends in sdx mksplit
#failing and REPLACING raw_runtime with the un-split original -
#which silently yields a zip kit with two zips and no tcl_library.
#(Latent until G-122 made the capability probe actually run on
#windows: before that every probe reported find-fail, so this list
#was always empty.)
set caps [dict get $runtime_caps $rtname]
set source_kit_caps [list]
if {[dict exists $caps has_zipfs] && [dict get $caps has_zipfs]} {
lappend source_kit_caps zip
}
if {[dict exists $caps has_starkit] && [dict get $caps has_starkit]} {
lappend source_kit_caps kit
}
if {[dict exists $caps has_cookfs] && [dict get $caps has_cookfs]} {
lappend source_kit_caps cookfs
}
#make our first try at extraction based on the kit type we are targeting
switch -- $target_kit_type {
zip - zipcat {
set extraction_trylist zip
}
cookit - cookfs {
set extraction_trylist cookfs
}
kit {
set extraction_trylist kit
}
default {
puts stderr "Unexpected target kit_type $kit_type - skipping $runtime_fullname"
continue
}
}
#also try extracting based on kit types the runtime seems to be capable of handling if the target_kit_type extraction doesn't work
foreach ktype $source_kit_caps {
if {$ktype ni $extraction_trylist} {
lappend extraction_trylist $ktype
}
}
#Assumption: a source runtime can/will only have 1 type of vfs attached
#While a runtime may support mounting more than one type - it is highly unlikely to support booting based on the type of vfs attached!
# e.g a tcl9 tclkit will be likely to have zipfs capability as well as starkit - but will only initialize from a starkit vfs
#Unknown if it's possible for multiple vfs data segments of different types in the one executable - but such a monstrosity is probably undesirable(?).
#It is quite possible to have more than one zip at the end of an exe - but as the capabilities of zip utilities in the wild to handle such a situation
#vary as far as how they behave - this too is most likely best considered as something to avoid.
set extract_kit_type ""
while {!$extraction_done && [llength $extraction_trylist]} {
set extract_kit_try [lpop extraction_trylist 0]
switch -- $extract_kit_try {
zip - zipcat {
#for a zipkit - we need to extract the existing vfs from the runtime
#zipfs mkimg replaces the entire zipped vfs in the runtime - so we need the original data to be part of our targetvfs.
puts stdout "Attempting to extract zip vfs data from $runtime_fullname"
file mkdir $targetvfs
set raw_runtime $buildfolder/raw_$runtime_fullname
if {[info commands ::tcl::zipfs::mount] ne ""} {
#the driving tcl has zipfs
set rtmountpoint //zipfs:/rtmounts/$runtime_fullname
if {![file exists $rtmountpoint]} {
if {[catch {
tcl::zipfs::mount $building_runtime rtmounts/$runtime_fullname
} errM]} {
puts stderr "Failed to mount $building_runtime using standard api. Err:$errM\n trying reverse args on tcl::zipfs::mount..."
if {[catch {
tcl::zipfs::mount rtmounts/$runtime_fullname $building_runtime
} errM]} {
puts stderr "ALSO Failed to mount $building_runtime using reverse args to api. Err:$errM - no mountable zipfs on runtime?"
}
}
}
#strip any existing zipfs on the runtime..
#2024 - 'zipfs info //zipfs:/mountpoint' is supposed to give us the offset - but it doesn't if the exe has been 'adjusted' to use file offsets.
#which unfortunately Tcl does by default after the 2021 'fix' :(
#https://core.tcl-lang.org/tcl/tktview/aaa84fbbc5
if {[file exists $rtmountpoint]} {
#merge_over source -> target
merge_over $rtmountpoint $targetvfs
set extraction_done 1
#see if we can extract the exe part
set baseoffset [lindex [tcl::zipfs::info $rtmountpoint] 3]
if {$baseoffset != 0} {
#tcl was able to determine the compressed-data offset
#either because runtime is a basic catted exe+zip, or Tcl fixed 'zipfs info'
set fdrt [open $building_runtime r]
chan configure $fdrt -translation binary
set exedata [read $fdrt $baseoffset] ;#may include stored password and ending header // REVIEW - strip it?
close $fdrt
set fdraw [open $raw_runtime w]
chan configure $fdraw -translation binary
puts -nonewline $fdraw $exedata
close $fdraw
} else {
#presumably the supplied building_runtime has had its offsets adjusted so that it all appears within offsets off the zip. (file relative offsets)
#due to zipfs info bug - zipfs now can't tell us the offset of the compressed data.
#we need to use a similarly assumptive method as tclZipfs.c uses to determine the start of the compressed contents
package require punk::zip
#we don't technically need to extract the raw exe for 'zip' - as zipfs mkimg can work on the combined file (ignores zip)
# - but for consistency we want raw_runtime to be emitted in the filesystem.
file delete $raw_runtime
punk::zip::extract_preamble $building_runtime $raw_runtime
}
} else {
#the input building_runtime wasn't mountable as a zip - so presumably a plain executable
#runtime executable possibly with kit/cookfs etc attached?
#If not - init.tcl probably won't be found? should we even proceed ??
puts stderr "[punkboot::sgr 31]WARNING the runtime was not mountable as a zip - which means tcl_library was not extracted - the executable may not work with zipfs attached![punkboot::sgr]"
file copy -force $building_runtime $raw_runtime
}
} else {
#The driving tcl we are calling with doesn't have zipfs - can't mount.
#punk::zip reads the attached archive with stock Tcl only (G-124),
#so this path needs no zipfs, no vfs::zip and no tcllib.
package require punk::zip
puts stdout "tcl shell '[info nameofexecutable]' being used to build doesn't have zipfs - reading the runtime's attached archive with punk::zip"
set extractedzipfolder $buildfolder/extracted_$runtime_fullname
file delete $raw_runtime
file delete -force $extractedzipfolder
if {![catch {
#Split off the executable prefix - the kit assembly needs it as a
#file. The MEMBERS are then read from the ORIGINAL runtime at its
#derived base offset: a runtime whose offsets are file-relative
#splits into a .zip no plain zip reader accepts, and reading the
#whole file sidesteps that intermediate entirely.
punk::zip::extract_preamble $building_runtime $raw_runtime
punk::zip::unzip -return none -- $building_runtime $extractedzipfolder
} extracterr]} {
set extraction_done 1
set extract_kit_type $extract_kit_try
#todo - verify that init.tcl etc are present?
merge_over $extractedzipfolder $targetvfs
} else {
#Do not swallow the reason: without the runtime's own
#zip contents the built kit has no tcl_library.
puts stderr "zipfs-less extraction of $runtime_fullname FAILED: $extracterr"
}
}
}
cookit - cookfs {
#upx easy enough to deal with if we have/install a upx executable (avail on windows via scoop, freshports for freebsd and presumably various for linux)
# ------------------------------------------------------
#we can't use cookfs with arbitrary tclsh/kits - needs cookit not just cookfs
# ------------------------------------------------------
#cookfs seems to need compilation - we would need to be able to build for windows,linux,freebsd,macosx at a minimum.
#preferably vi cross-compile using zig.
#cookit also
#If our calling executable is also a cookit, or has cookfs package available we can manipulate the cookit runtime here
#(e.g we have it as a loadable module for tcl9 on windows in some runtimes - todo)
if {[catch {package require cookfs} version]} {
puts stderr "cookit/cookvfs unsupported - unable to load cookfs"
puts stderr " - Try running make.tcl using a cookkit binary (e.g put it in <projectdir>/bin) or installing the cookfs binary module or tcl-cookfs module"
} else {
puts stdout "Attempting to extract existing cookfs data from $runtime_fullname"
file mkdir $targetvfs
#Mount it in the currently running executable
#REVIEW - it seems to work to pick a pseudovol name like //cookfstemp:/
#unlike cookit's //cookit:/ it doesn't show up in file volumes
#set rtmountpoint //cookfstemp:/rtmounts/$runtime_fullname ;#not writable with 'file mkdir' which doesn't seem to handle intermediate nonexistant path
set rtmountpoint //cookfstemp:/$runtime_fullname
cookfs::Mount $building_runtime $rtmountpoint
if {[file exists $rtmountpoint]} {
#copy from mounted runtime's vfs to the filesystem vfs
merge_over $rtmountpoint $targetvfs
set extraction_done 1
set extract_kit_type $extract_kit_try
}
}
}
kit {
if {!$have_sdx} {
puts stderr "no sdx available to unwrap $targetkit"
#don't add to failed_kits here
#extraction fail for one type doesn't mean we have fully failed yet
#lappend failed_kits [list kit $targetkit reason "sdx_executable_unavailable"]
#$vfs_event targetset_end FAILED
#$vfs_event destroy
#$vfs_installer destroy
continue ;#to next extraction attempt
}
set raw_runtime $buildfolder/raw_$runtime_fullname
#for a kit, we shouldn't need to extract the existing vfs from the runtime.
# - the sdx merge process should be able to merge our .vfs folder with the existing contents.
#2025 - in practice this doesn't always seem to be the case? Review - could have been cwd issue?
puts stdout "Attempting to split kitfile using: $::sdxpath mksplit $building_runtime"
set prev_cwd [pwd]
cd [file dirname $building_runtime] ;#make sure SDX is called with the same working dir as the files we're working on.
if {[catch {exec {*}$::sdxpath mksplit $building_runtime} mksplitresult]} {
#executable doesn't have kit vfs attached
puts stderr "No kit data extracted from $building_runtime"
file copy -force $building_runtime $raw_runtime
} else {
puts stdout "mksplitresult: $mksplitresult"
if {![file exists [file rootname $building_runtime].tail]} {
error "mksplit didn't produce file at [file rootname $building_runtime].tail"
}
file delete -force [file rootname $building_runtime].vfs ;#ensure target for unwrap doesn't exist
#set kit_bare_runtime [file rootname $building_runtime].head
set building_runtime [file rootname $building_runtime].head
exec {*}$::sdxpath unwrap [file rootname $building_runtime].tail ;#extracts to folder named [file rootname $building_runtime].vfs e.g build_tclkit9.0.2-win64-dyn.vfs
#file rename to existing target dir would copy folder into target dir
if {![file exists $targetvfs]} {
#delay
after 1000
file rename [file rootname $building_runtime].vfs $targetvfs
} else {
merge_over [file rootname $building_runtime].vfs $targetvfs
}
set extraction_done 1
set extract_kit_type $extract_kit_try
file copy -force $building_runtime $raw_runtime
}
cd $prev_cwd
}
}
} ;#end while !$extraction_done && [llength $extraction_trylist]
set extraction_tried "$target_kit_type[expr {[llength $source_kit_caps] ? " + runtime caps $source_kit_caps" : ""}]"
if {!$extraction_done} {
#TODO: if not extracted - use a default tcl_library for patchlevel and platform?
#Recapped BUILD-WARNING (not just an inline note): this line would
#otherwise scroll away behind thousands of merge lines. It is a warning
#rather than the failure itself because a .vfs that supplies its own tcl
#library needs no extraction - the G-125 gate below decides, on the
#merged tree, whether this kit can initialise.
::punkboot::print_build_warnings [list "No extraction done from runtime $runtime_fullname (tried: $extraction_tried) - kit $targetkit gets no tcl library from the runtime, so it will FAIL the boot-precondition gate unless src/vfs/$vfstail supplies one"]
file mkdir $targetvfs
}
#set wrapvfs $sourcefolder/$vfs
set kit_type_mismatch 0
switch -- $extract_kit_type {
zip {
if {$target_kit_type ni {zip zipcat}} {
set kit_type_mismatch 1
}
}
kit {
if {$target_kit_type ne "kit"} {
set kit_type_mismatch 1
}
}
cookfs {
if {$target_kit_type ni {cookfs cookit}} {
set kit_type_mismatch 1
}
}
}
if {$kit_type_mismatch} {
puts stderr "--------------------------------------------"
puts stderr "WARNING: mismatch between kit type of source runtime [punk::ansi::a brightyellow]$extract_kit_type[punk::ansi::a] and target kit type [punk::ansi::a brightyellow]$target_kit_type[punk::ansi::a]"
puts stderr "The resulting kit is unlikely to initialise"
puts stderr "--------------------------------------------"
#G-030 prompt policy: only an interactive 'y' can force building a mismatched
#kit - non-interactive runs (and -confirm 0) skip this kit and continue.
set _build_anyway 0
if {!$::punkboot::opt_confirm} {
puts stderr "skipping kit $targetkit (source/target kit type mismatch; -confirm 0 policy is to skip)"
} elseif {![::punkboot::lib::stdin_is_interactive]} {
puts stderr "skipping kit $targetkit (source/target kit type mismatch and stdin is not interactive)"
} else {
puts stdout "Continue to try to build $targetkit from $rtname anyway? y|n"
if {[string tolower [string trim [gets stdin]]] eq "y"} {
set _build_anyway 1
}
}
if {!$_build_anyway} {
#skip to next kit
continue
}
puts proceeding...
}
if {[file exists $sourcefolder/vfs/_vfscommon.vfs]} {
puts stdout "Merging _vfscommon.vfs over $targetvfs"
#the original boot.tcl and icon etc can be overridden by entries in our common and custom vfs folders
#merge_over will emit warnings on stderr for overwritten files
merge_over $sourcefolder/vfs/_vfscommon.vfs $targetvfs
}
set sourcevfs [file join $sourcefolder vfs $vfstail]
merge_over $sourcevfs $targetvfs
#G-133 advisory payload/target binary-arch scan, at the same post-merge
#seam as the G-125 gate below. Structural (header bytes only, nothing
#executed), so it runs for every kit including cross-target ones. A
#binary library under a platform-discriminated subdir (win32-ix86/,
#win-x64/ etc) is exempt - multi-arch payloads are legitimate there.
#ADVISORY by design: vendor layouts make false certainty unavoidable,
#so mismatches warn (recapped) and the kit still builds - the G-125
#gate below stays the only refusal at this seam.
lassign [::punkboot::get_vfs_binary_arch_report $targetvfs $rt_target] archscan_available archscan
if {!$archscan_available} {
puts stderr "NOTE: kit payload binary-arch scan unavailable (punkboot::utils vfs_binary_arch_report not loadable from bootsupport) - continuing without it"
} elseif {[dict get $archscan reason] ne ""} {
puts stdout " payload binary-arch scan not applicable for kit $targetkit: [dict get $archscan reason]"
} elseif {[llength [dict get $archscan mismatches]]} {
set archscan_mismatches [dict get $archscan mismatches]
set archwarnings [list]
set shown 0
foreach m $archscan_mismatches {
if {$shown >= 8} {break}
incr shown
lappend archwarnings "payload/target arch mismatch in kit $targetkit (target $rt_target): [dict get $m file] is [dict get $m detail] outside any platform-discriminated subdir - a $rt_target runtime cannot load it"
}
if {[llength $archscan_mismatches] > $shown} {
lappend archwarnings "payload/target arch mismatch in kit $targetkit (target $rt_target): [expr {[llength $archscan_mismatches] - $shown}] further mismatching binary libraries not listed above ([llength $archscan_mismatches] mismatches total, [dict get $archscan scanned] binary libraries scanned)"
}
::punkboot::print_build_warnings $archwarnings
unset archwarnings archscan_mismatches shown
} else {
puts stdout " payload binary-arch scan for kit $targetkit (target $rt_target): OK - [dict get $archscan scanned] binary libraries scanned ([dict get $archscan matched] match target, [dict get $archscan exempt] exempt under platform subdirs, [dict get $archscan unknown] unclassifiable)"
}
#G-125 boot-precondition gate. A kit with no tcl library cannot initialise
#at all - 'Cannot find a usable init.tcl' - so refuse it HERE: before any
#build product is written, and long before the deploy step deletes the
#previously working bin/<kit> and copies the new one over it. The check is
#on the MERGED tree rather than on whether extraction ran, because a .vfs
#that supplies its own tcl library is legitimate and must keep building
#(src/vfs/punk8_statictwapi.vfs and punk9test.vfs are such folders today).
#Structural and non-executing, so it also covers cross-target kits, which
#this host could never run.
lassign [::punkboot::get_vfs_boot_library_report $targetvfs] bootcheck_available bootcheck
if {!$bootcheck_available} {
puts stderr "NOTE: kit boot-precondition check unavailable (punkboot::utils vfs_boot_library_report not loadable from bootsupport) - continuing without it"
} elseif {![dict get $bootcheck ok]} {
if {$extraction_done} {
#extract_kit_type is only recorded by some of the extraction branches
set extractedas [expr {$extract_kit_type ne "" ? " (as $extract_kit_type)" : ""}]
set gatecause "extraction from runtime $runtime_fullname$extractedas ran but supplied no tcl library, and src/vfs/$vfstail does not supply one either"
} else {
set gatecause "nothing was extracted from runtime $runtime_fullname (tried: $extraction_tried) and src/vfs/$vfstail does not supply a tcl library"
}
set failmsg "kit cannot initialise - $gatecause. Checked [join [dict get $bootcheck checked] { and }] in the merged vfs; [dict get $bootcheck reason]. NOT BUILT and NOT DEPLOYED: any previously deployed $targetkit is untouched"
puts stderr "boot-precondition gate FAILED for kit $targetkit - refusing to build an artifact that cannot initialise"
puts stderr " $gatecause"
lappend failed_kits [list kit $targetkit reason $failmsg]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
}
#G-057 kit icon step: sidecar for every kit; PE icon embedding where
#the target has PE resources and this host can write them. Stub-first:
#the assemblers below consume wrap_runtime - the stamped per-kit copy
#of the payload-free raw prefix when embedding happened, the untouched
#raw prefix otherwise. Runtime store originals are never modified.
lassign [::punkboot::kit_icon_process $targetkit $rt_target $rtname $target_kit_type $sourcefolder $vfstail $raw_runtime $buildfolder] wrap_runtime kiticon_sidecar
set wrapvfs $targetvfs
switch -- $target_kit_type {
zip {
#WARNING - 2024-10-08 - zipfs mkimg based exezips are not editable with 7z
# (central directory offset has been 'adjusted' to be file relative)
#This makes finding the split between prefixed exe and zip-data harder for Tcl scripts
#- although zipfs mkimg does it in a somewhat wonky way.
#tclZipfs.c as at 2024 assumes first file header in the CDR points to first local file header and assumes that is the top of the zipdata.
#This is only *mostly* true. order of entries or completeness is not guaranteed.
#e.g topmost file data in zip may not be pointed to if deleted by certain tools.
#for files created by zipfs mkimg and not externally edited - it shouldn't be an issue though.
if {$rtname eq "-"} {
#todo - just make a zip?
error "runtime name of - unsupported for zip - (todo)"
}
if {[catch {
if {[dict exists $runtime_caps $rtname]} {
if {[dict get $runtime_caps $rtname exitcode] == 0} {
if {![dict get $runtime_caps $rtname has_zipfs]} {
error "runtime $rtname doesn't have zipfs capability"
}
} else {
#could be runtime for another platform
puts stderr "RUNTIME capabilities unknown. Unsure if zip supported. trying anyway.."
}
}
if {[info commands ::tcl::zipfs::mkimg] ne ""} {
#note - as at 2024-08 - there is some discussion about the interface to mkimg - it is considered unstable (may change to -option value syntax)
puts stderr "calling: tcl::zipfs::mkimg $buildfolder/$vfsname.new $wrapvfs $wrapvfs \"\" $wrap_runtime"
tcl::zipfs::mkimg $buildfolder/$vfsname.new $wrapvfs $wrapvfs "" $wrap_runtime
} else {
#G-122: the driving tcl has no zipfs (8.6) - assemble the same
#kind of image by concatenation. The result mounts on any
#zipfs-capable runtime (archive-start-relative offsets).
puts stderr "WARNING: tcl shell '[info nameofexecutable]' has no zipfs - assembling zip kit $targetkit by concatenation (raw runtime + mkzip)"
::punkboot::assemble_zipcat_image $wrap_runtime $wrapvfs $buildfolder/$vfsname.new $buildfolder/$vfsname.zip
}
} result ]} {
set failmsg "zipfs mkimg failed with msg: $result"
puts stderr "tcl::zipfs::mkimg $targetkit failed"
lappend failed_kits [list kit $targetkit reason $failmsg]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
} else {
puts stdout "ok - finished zip image assembly"
set separator [string repeat = 40]
puts stdout $separator
puts stdout $result
puts stdout $separator
}
}
zipcat {
#simple catenated runtime + zip - we need an exe runtime with no zipfs attached..
if {$rtname eq "-"} {
#todo - just make a zip?
error "runtime name of - unsupported for zip - (todo)"
}
if {[catch {
if {[dict exists $runtime_caps $rtname]} {
if {[dict get $runtime_caps $rtname exitcode] == 0} {
if {![dict get $runtime_caps $rtname has_zipfs]} {
error "runtime $rtname doesn't have zipfs capability"
}
} else {
#could be runtime for another platform
puts stderr "RUNTIME capabilities unknown. Unsure if zip supported. trying anyway.."
}
}
#'archive' based zip offsets - editable in 7z,peazip
::punkboot::assemble_zipcat_image $wrap_runtime $wrapvfs $buildfolder/$vfsname.new $buildfolder/$vfsname.zip
} result ]} {
set failmsg "creating zipcat image failed with msg: $result"
puts stderr "creating image (zipcat) $targetkit failed"
lappend failed_kits [list kit $targetkit reason $failmsg]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
} else {
puts stdout "ok - finished zipcat image"
set separator [string repeat = 40]
puts stdout $separator
puts stdout $result
puts stdout $separator
}
}
cookit - cookfs {
if {$rtmountpoint eq ""} {
lappend failed_kits [list kit $targetkit reason mount_failed]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
} else {
if {[catch {
#we still have the $building_runtime mounted
if {[catch {
merge_over $targetvfs $rtmountpoint
} errM]} {
puts stderr "$target_kit_type 'merge_over $targetvfs $rtmountpoint' failed\n$errM"
error $errM
}
if {[catch {
cookfs::Unmount $rtmountpoint
} errM]} {
puts stderr "$target_kit_type 'cookfs::Unmount $rtmountpoint' failed\n$errM"
error $errM
}
#copy the version that is mounted in this runtime to vfsname.new
if {[catch {
file copy -force $building_runtime $buildfolder/$vfsname.new
catch {exec chmod +w $buildfolder/$vfsname.new}
} errM]} {
puts stderr "$target_kit_type 'file copy -force $building_runtime $buildfolder/$vfsname.new' failed\n$errM"
error $errM
}
} result]} {
puts stderr "Writing vfs data and opying cookfs file $building_runtime to $buildfolder/$vfsname.new failed\n $result"
lappend failed_kits [list kit $targetkit reason copy_failed]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
} else {
puts stdout "ok - finished for target kit type: $target_kit_type"
set separator [string repeat = 40]
puts stdout $separator
puts stdout $result
puts stdout $separator
}
}
}
kit {
set verbose ""
#set verbose "-verbose"
#assert: building_runtime has been replaced with $kit_bare_runtime
set prev_cwd [pwd]
cd [file dirname $building_runtime] ;#make sure SDX is called with the same working dir as the files we're working on.
if {[catch {
if {$rtname ne "-"} {
exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $wrap_runtime {*}$verbose
} else {
exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose
}
} result]} {
if {$rtname ne "-"} {
set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $wrap_runtime {*}$verbose failed with msg: $result"
} else {
set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result"
}
puts stderr "$::sdxpath wrap $targetkit failed"
lappend failed_kits [list kit $targetkit reason $sdxmsg]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
} else {
puts stdout "ok - finished for target kit type: sdx"
set separator [string repeat = 40]
puts stdout $separator
puts stdout $result
puts stdout $separator
}
cd $prev_cwd
}
}
if {![file exists $buildfolder/$vfsname.new]} {
puts stderr "|err> make.tcl build didn't seem to produce output at $buildfolder/$vfsname.new"
lappend failed_kits [list kit $targetkit reason "build failed to produce output at $buildfolder/$vfsname.new"]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
}
# -- --- ---
#tasklist doesn't support getting full commandline of processname
#This means we can't be sure we're shutting down the exact required process
#to do this properly we should check the full path for both ps on unix and on windows. (TODO)
#(same exename could be installed somewhere else on the system running a process that shouldn't be shut down here)
#powershell 'get-process' can give us the full path.
#Getting the process list on windows, whether with tasklist or powershell is very slow compared to unix ps.
# e.g 100x slower - apparently that's just the nature of the OS differences (?)
#still - seems to be under 1s on a 2018 era i9 running in 2025 - which is not a big problem in this context.
#using a filter in tasklist or get-command can make things a little faster
#G-122: the tooling follows the TARGET, not the driving tclsh.
#A win32 kit is a windows process whatever baked it - and msys 'ps'
#sees only msys-descendant processes, so an msys-hosted build using
#'ps' would report a natively-launched kit as not running and then
#fail to replace it. tasklist/taskkill exec fine from an msys tclsh.
#When target and host process worlds differ (a cross-target bake) no
#local process can be holding the artifact - skip the sweep rather
#than run tooling that cannot see the target's processes anyway.
set target_proc_family [punkboot::lib::platform_process_family $rt_target]
set host_proc_family [punkboot::lib::platform_process_family $::punkboot::host_platform]
if {$target_proc_family eq "windows"} {
set pscmd "tasklist"
set pid_field 1
} else {
set pscmd "ps"
set pid_field 0
}
set sweep_applicable [expr {$target_proc_family eq $host_proc_family}]
if {!$sweep_applicable} {
puts stdout " (skipping running-process sweep for $targetkit - target $rt_target processes are not visible to this $::punkboot::host_platform host)"
}
#killing process doesn't apply to .kit build
if {$rtname ne "-" && $sweep_applicable} {
#exec $pscmd | grep $targetkit ;#wrong - fails on at least some OSes because grep itself is in the list
#exec ps | grep $targetkit | grep -v grep ;#exclude grep process
if {![catch {
::punkboot::exec_nativeargs [list $pscmd]
} ps_lines]} {
#we will process without grep for for now - may not be avail on windows?
set still_running_lines [list]
foreach ln [split [string trim $ps_lines] \n] {
if {[string match "* grep *" $ln]} {continue}
if {[string match "*$targetkit*" $ln]} {
#never target the process running this build. Name-only matching
#cannot distinguish an unrelated same-named executable elsewhere on
#the system (see TODO above) - but the build must at least not kill
#itself (e.g a copy of the target executable driving this build from
#a path other than the deploy target, which the self-build guard
#above doesn't catch).
set ln_pid [lindex $ln $pid_field]
if {$ln_pid eq [pid]} {continue}
lappend still_running_lines $ln
}
}
#set still_running_lines [split [string trim $still_running] \n]
puts stdout "found ([llength $still_running_lines]) $targetkit instances still running\n"
set count_killed 0
set num_to_kill [llength $still_running_lines]
foreach ln $still_running_lines {
puts stdout " $ln"
set pid [lindex $ln $pid_field]
if {$target_proc_family eq "windows"} {
if {$forcekill} {
set killcmd [list taskkill /F /PID $pid]
} else {
set killcmd [list taskkill /PID $pid]
}
} else {
#review!
if {$forcekill} {
set killcmd [list kill -9 $pid]
} else {
set killcmd [list kill $pid]
}
}
puts stdout " pid: $pid (attempting to kill now using '$killcmd')"
if {[catch {
::punkboot::exec_nativeargs $killcmd
} errMsg]} {
puts stderr "$killcmd returned an error:"
puts stderr $errMsg
if {!$forcekill} {
puts stderr "(try '[info script] -k' option to force kill)"
}
#avoid exiting if the kill failure was because the task has already exited
#review - *no running instance* works with windows taskkill - "*No such process*" works with kill -9 on FreeBSD and linux - other platforms?
if {![string match "*no running instance*" $errMsg] && ![string match "*No such process*" $errMsg]} {
lappend failed_kits [list kit $targetkit reason "could not kill running process for $targetkit (using '$killcmd')"]
continue
}
} else {
puts stderr "$killcmd ran without error"
incr count_killed
}
}
if {$count_killed < $num_to_kill} {
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
}
puts stderr "\nKilled $count_killed processes. Waiting a short time before attempting to delete executable"
after 1000
} else {
puts stderr "Ok.. no running '$targetkit' processes found"
}
}
if {[file exists $buildfolder/$targetkit]} {
puts stderr "deleting existing $buildfolder/$targetkit"
if {[catch {
file delete $buildfolder/$targetkit
} msg]} {
puts stderr "Failed to delete $buildfolder/$targetkit"
lappend failed_kits [list kit $targetkit reason "could not delete buildfolder kit at $buildfolder/$targetkit"]
$vfs_event targetset_end FAILED
$vfs_event destroy
$vfs_installer destroy
continue
}
}
#WINDOWS filesystem 'tunnelling' (file replacement within 15secs) could cause targetkit to copy ctime & shortname metadata from previous file!
#This is probably harmless - but worth being aware of.
file rename $buildfolder/$vfsname.new $buildfolder/$targetkit
# -- --- --- --- --- ---
$vfs_event targetset_end OK
#G-133 post-build smoke-require probe. Only an actual 'package require'
#inside the built artifact observes package RESOLUTION - the wrong-arch
#version-shadowing class is invisible to every structural check because
#the working file exists too. Runs only for kits that declare
#smoke-require packages (mapvfs.config 5th entry element) and only when
#this host can execute the artifact; undeclared kits run nothing new.
if {[llength $kit_smokerequires]} {
if {$rtname eq "-"} {
puts stdout " smoke-require skipped for kit $targetkit: a runtimeless .kit artifact is not directly executable"
} elseif {[punkboot::lib::platform_process_family $rt_target] ne [punkboot::lib::platform_process_family $::punkboot::host_platform]} {
puts stdout " smoke-require skipped for kit $targetkit: cross-target ($rt_target) - the artifact is not executable on this $::punkboot::host_platform host"
} else {
puts stdout " smoke-require probe for kit $targetkit (packages: $kit_smokerequires) - executing freshly built artifact via its tclsh subcommand"
::punkboot::kit_smoke_require_probe $buildfolder/$targetkit $targetkit $kit_smokerequires
}
}
} else {
set skipped_vfs_build 1
puts stderr "."
puts stdout "Skipping build for vfs $vfstail with runtime $rtname - no change detected"
lappend skipped_kits [list kit $targetkit reason "no change detected"]
$vfs_event targetset_end SKIPPED
}
$vfs_event destroy
$vfs_installer destroy
#TODO - allow building of kits for other platforms
# - we need to use <project>/bin for only kits targetting current platform,
# and use <project>/bin/<platform> for others
# that we we can have same target executable for multiple platforms e.g executable just named 'punkshell'
# - to do this we need to change runtime/mapvfs.config to have platform names not just standalone target executable names
# (todo: change to toml format at same time)
after 200
set deployment_folder [file dirname $sourcefolder]/bin
file mkdir $deployment_folder
# -- ----------
set bin_installer [punkcheck::installtrack new "make.tcl" $deployment_folder/.punkcheck]
$bin_installer set_source_target $buildfolder $deployment_folder
set bin_event [$bin_installer start_event {-make-step final_kit_install}]
$bin_event targetset_init INSTALL $deployment_folder/$targetkit
#todo - move final deployment step outside of the build vfs loop? (final deployment can fail and then isn't rerun even though _build and deployed versions differ, unless .vfs modified again)
#set last_completion [$bin_event targetset_last_complete]
$bin_event targetset_addsource $deployment_folder/$targetkit ;#add target as a source of metadata for change detection
$bin_event targetset_addsource $buildfolder/$targetkit
$bin_event targetset_started
# -- ----------
set changed_unchanged [$bin_event targetset_source_changes]
set built_or_installed_kit_changed [expr {[llength [dict get $changed_unchanged changed]] || [llength [$bin_event get_targets_exist]] < [llength [$bin_event get_targets]]}]
if {$built_or_installed_kit_changed} {
if {[file exists $deployment_folder/$targetkit]} {
puts stderr "built or deployed kit changed - deleting existing deployed at $deployment_folder/$targetkit"
if {[catch {
file delete $deployment_folder/$targetkit
} errMsg]} {
puts stderr "deletion of deployed version at $deployment_folder/$targetkit failed: $errMsg"
lappend failed_kits [list kit $targetkit reason "could not delete target binary at $deployment_folder/$targetkit"]
$bin_event targetset_end FAILED -note "could not delete"
$bin_event destroy
$bin_installer destroy
continue
}
}
puts stdout "copying.."
puts stdout "$buildfolder/$targetkit"
puts stdout "to:"
puts stdout "$deployment_folder/$targetkit"
after 300
file copy $buildfolder/$targetkit $deployment_folder/$targetkit
#G-057: the kit resource sidecar ships with the kit
if {[file isfile $buildfolder/$targetkit.resources.toml]} {
file copy -force $buildfolder/$targetkit.resources.toml $deployment_folder/$targetkit.resources.toml
}
lappend installed_kits $targetkit
# -- ----------
$bin_event targetset_end OK
# -- ----------
} else {
set skipped_kit_install 1
puts stderr "."
puts stdout "Skipping kit install for $targetkit with vfs $vfstail runtime $rtname - no change detected"
#G-057: keep the deployed resource sidecar current even when the kit
#itself is unchanged (the record can be newer than the kit rebuild -
#e.g the sidecar feature arriving, or a host-capability change)
if {[::punkboot::kiticon::copy_ifchanged $buildfolder/$targetkit.resources.toml $deployment_folder/$targetkit.resources.toml] eq "copied"} {
puts stdout " kit icon (G-057): refreshed deployed sidecar $deployment_folder/$targetkit.resources.toml"
}
lappend skipped_kit_installs [list kit $targetkit reason "no change detected"]
$bin_event targetset_end SKIPPED
}
$bin_event destroy
$bin_installer destroy
} ;#end foreach targetkit
} ;#end foreach rtname in runtimes
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
}
cd $startdir
if {[llength $installed_kits]} {
puts stdout "INSTALLED KITS: ([llength $installed_kits])"
punk::lib::showdict -channel stdout -roottype list $installed_kits
}
if {[llength $failed_kits]} {
puts stderr "FAILED KITS:([llength $failed_kits])"
punk::lib::showdict -channel stderr -roottype list $failed_kits */@*.@*
#puts stderr [join $failed_kits \n]
}
set had_kits [expr {[llength $installed_kits] || [llength $failed_kits] || [llength $skipped_kits]}]
if {$had_kits} {
puts stdout " module builds and kit/zipkit builds processed (vfs config: src/runtime/mapvfs.config)"
puts stdout " - use 'make.tcl modules' to build modules without baking the vfs folders into executable kits/zipkits"
puts stdout " - use 'make.tcl vfscommonupdate' to promote built modules into the base vfs folder <projectdir>/src/vfs/_vfscommon.vfs (promotion gate)"
puts stdout " - Note that without the vfscommonupdate step, 'make.tcl bake' (the kit-assembly stage of 'make.tcl bakehouse') will build vfs based executables"
puts stdout " that include your current custom vfs folders in src/vfs, but with a _vfscommon.vfs that doesn't have the latest built modules"
puts stdout " calling 'builtexename(.exe) dev' will allow testing of built modules before they are baked into the kits/zipkits via 'vfscommonupdate' then 'bake'"
} else {
puts stdout " module builds processed"
puts stdout ""
puts stdout " If kit/zipkit based executables required - create src/vfs/<somename>.vfs folders containing lib,modules,modules_tcl9 etc folders"
puts stdout " Also ensure appropriate executables exist in src/runtime along with src/runtime/mapvfs.config"
}
puts stdout "-done-"
exit 0