Browse Source
Increment 3 - the kit-head (opt-in suite step "kithead"):
- build_kithead86/kithead.c: static Mk4tcl+vfs registration, preinit
reading boot.tcl from the exe's own mk4 file, post-init main.tcl pivot
(kbskit kitInit.c reduced to the 8.6 mk4 case; the 8.6.18 headers have
no Tcl_StaticLibrary - stock tclAppInit.c's file-local compat define
mirrored).
- build_kithead86/boot.tcl: kbskit boot.tcl mk4-only/8.6-only (tclInit
override, raw mk::select hand-eval of vfsUtils/vfslib/mk4vfs, mount +
encoding remount, in-kit init.tcl, auto_path reset).
- tools/mk4kit_attach.tcl: setupvfs role under the suite dynamic shell
(mount rw, lib trees + lf-normalized boot.tcl, tclvfs scripts with the
pkgIndex vfs entry rewritten to "load {} vfs").
- build86.zig: kithead exe (core+reg/dde+stubs as tclsh86ts, two-anchor
tclAppInit overlay, engine+binding via build_mk4tcl86 pub lists, static
tclvfs w/ STATIC_BUILD); artifact bin/tclsh8.6.18-mk4-r1.exe; smoke
asserts info library INSIDE the exe. No rechan needed (vfslib memchan
rides 8.6 reflected channels).
Increment 4 - the demonstration (hermetic env, PATH=System32, bare dir):
- head boots with library inside itself on a Tcl-free path;
- the RUNNING head ran sdx and wrapped a SEPARATE COPY of itself
(self-mount rider as specified);
- the starpack runs main.tcl from inside, reads vfs data, loads a
kit-only package, and loads thread2813t.dll FROM the vfs (dll clause
measured, not inherited).
Goal detail: Progress 3+4, Assessment (four candidates vs the four kit
expectations), Decision (mk4 = the 8.6 container and punk86 default;
zipfs backport stays the recorded G-131 second arm), Follow-on-to-parity
list; Status -> achieved 2026-08-02. Archive move follows separately.
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
8 changed files with 681 additions and 11 deletions
@ -0,0 +1,87 @@
|
||||
# boot.tcl - punkshell suite_tcl86 mk4 kit-head boot script (G-101). |
||||
# |
||||
# Lives at the ROOT of the kit-head's attached Metakit vfs (written there by |
||||
# tools/mk4kit_attach.tcl); the pre-init script compiled into the head |
||||
# (build_kithead86/kithead.c) extracts and evaluates it before init.tcl, for |
||||
# every interp. |
||||
# |
||||
# Derived from the Tclkit lineage's boot.tcl as carried by kbskit 0.4 |
||||
# (Tcl-style license.terms), reduced to the 8.6 mk4 case: no vlerq/mkcl |
||||
# branch, no 8.4 pwb/librarypath branch. The proc tclInit override below is |
||||
# the 8.6 boot hook; Tcl 9 removes the tclInit override entirely |
||||
# (preinit-only) - the cross-generation generalisation is goals G-131 |
||||
# territory, recorded in goals/G-101-tcl86-kit-container-strategy.md. |
||||
|
||||
proc tclInit {} { |
||||
rename tclInit {} |
||||
|
||||
global auto_path tcl_library tcl_libPath tcl_version tclkit_system_encoding |
||||
|
||||
set noe $::tcl::kitpath |
||||
# resolve symlinks |
||||
set noe [file dirname [file normalize [file join $noe __dummy__]]] |
||||
set tcl_library [file join $noe lib tcl$tcl_version] |
||||
set tcl_libPath [list $tcl_library [file join $noe lib]] |
||||
|
||||
# get rid of a build residue |
||||
unset -nocomplain ::tclDefaultLibrary |
||||
|
||||
# Mount only when this interp does not already see the exe as a |
||||
# directory - happens once per thread; child interps see the mount. |
||||
if {![file isdirectory $noe]} { |
||||
load {} vfs |
||||
|
||||
# source lib/vfs1*/{vfsUtils,vfslib,mk4vfs}.tcl out of the still |
||||
# unmounted container with raw Metakit calls (VFS not in place yet) |
||||
set d [mk::select exe.dirs parent 0 name lib] |
||||
set d [mk::select exe.dirs parent $d -glob name vfs1*] |
||||
|
||||
foreach x {vfsUtils vfslib mk4vfs} { |
||||
set n [mk::select exe.dirs!$d.files name $x.tcl] |
||||
if {[llength $n] != 1} { error "$x: cannot find startup script" } |
||||
set s [mk::get exe.dirs!$d.files!$n contents] |
||||
catch {set s [zlib decompress $s]} |
||||
uplevel #0 $s |
||||
} |
||||
# 8.6 keeps mk4vfs::zstreamed at its default 0: core zlib does not |
||||
# provide the streamed-channel shape mk4vfs would need (kbskit |
||||
# boot.tcl note); compressed reads go whole-blob through |
||||
# vfs::memchan, which vfslib implements over 8.6 reflected channels. |
||||
|
||||
# mount the executable - all runtime files become visible |
||||
vfs::filesystem mount $noe [list ::vfs::mk4::handler exe] |
||||
|
||||
# encodings live inside the freshly mounted library |
||||
encoding dirs [list [file join [info library] encoding]] ;# TIP 258 |
||||
# apply the environment encoding recorded by the C side, now that |
||||
# the encoding files are reachable |
||||
if {[info exists tclkit_system_encoding]} { |
||||
catch {encoding system $tclkit_system_encoding} |
||||
unset tclkit_system_encoding |
||||
} |
||||
# fix system encoding if it never got set up (identity residue) |
||||
if {[encoding system] eq "identity"} { |
||||
switch $::tcl_platform(platform) { |
||||
windows { encoding system cp1252 } |
||||
default { encoding system iso8859-1 } |
||||
} |
||||
} |
||||
|
||||
# remount so path handling reflects the corrected system encoding |
||||
vfs::filesystem unmount $noe |
||||
set noe $::tcl::kitpath |
||||
set noe [file dirname [file normalize [file join $noe __dummy__]]] |
||||
set tcl_library [file join $noe lib tcl$tcl_version] |
||||
set tcl_libPath [list $tcl_library [file join $noe lib]] |
||||
vfs::filesystem mount $noe [list ::vfs::mk4::handler exe] |
||||
} |
||||
|
||||
# optional per-kit config hook (tclkit convention) |
||||
namespace eval ::vfs { variable tclkit_version 1 } |
||||
catch { uplevel #0 [list source [file join $noe config.tcl]] } |
||||
|
||||
uplevel #0 [list source [file join $tcl_library init.tcl]] |
||||
|
||||
# reset auto_path so init.tcl's search outside the kit is cancelled |
||||
set auto_path $tcl_libPath |
||||
} |
||||
@ -0,0 +1,123 @@
|
||||
/* kithead.c - punkshell suite_tcl86 mk4 kit-head boot support (G-101).
|
||||
* |
||||
* Static-package registration plus the pre-init script that reads boot.tcl |
||||
* out of the executable's own attached Metakit file, and the post-init |
||||
* startup pivot to an attached main.tcl (starpack case). Compiled ONLY into |
||||
* the kit-head executable (see build86.zig kit-head section); the plain |
||||
* shells stay stock. The tclAppInit overlay calls the two entry points |
||||
* around Tcl_Init. |
||||
* |
||||
* Derived from the Tclkit lineage's kitInit.c as carried by kbskit 0.4 |
||||
* (Jean-Claude Wippler, ActiveState, Pat Thoyts, Rene Zaumseil; Tcl-style |
||||
* license.terms), reduced to the 8.6 mk4 case: |
||||
* - no vlerq/KIT_LITE branch, no 8.4/8.5 compat, no Tk console hooks |
||||
* - no zlib static package (8.6 core carries the zlib command) |
||||
* - no rechan (tclvfs 1.4.2 vfslib rides 8.6 reflected channels) |
||||
* - ::tcl::kitpath is set by the pre-init script from |
||||
* [info nameofexecutable] rather than via the tclkitpath C package |
||||
* (no stardll ambitions; revisit if a dll-shaped head ever appears) |
||||
* - std-channel repair dropped: the console shells this head derives from |
||||
* always have std channels; a windowed variant would need it back |
||||
*/ |
||||
|
||||
#include <tcl.h> |
||||
#include <string.h> |
||||
|
||||
/* 8.6 spells it Tcl_StaticPackage; the alias below is stock tclAppInit.c's
|
||||
* own forward-compat shim (win/tclAppInit.c:26-29 in the 8.6.18 tree). */ |
||||
#if TCL_MAJOR_VERSION < 9 |
||||
# define Tcl_StaticLibrary Tcl_StaticPackage |
||||
#endif |
||||
|
||||
/* Internal routine, no stub entry: resolves at link time inside the static
|
||||
* shell (the same hand-declaration kitInit.c:50 uses on 8.6-era cores). */ |
||||
extern char *TclSetPreInitScript(char *); |
||||
|
||||
extern int Mk4tcl_Init(Tcl_Interp *interp); |
||||
extern int Vfs_Init(Tcl_Interp *interp); |
||||
|
||||
/* Runs for EVERY new interp (child and thread interps included) in place of
|
||||
* the stock init-library search; boot.tcl's tclInit override guards |
||||
* re-mounting (kitInit.c's re-entrancy comment). A failure surfaces on |
||||
* stderr through Tcl_Main's init-failure report rather than silently. */ |
||||
static char preInitCmd[] = |
||||
"proc tclKitPreInit {} {\n" |
||||
"rename tclKitPreInit {}\n" |
||||
"set ::tcl::kitpath [info nameofexecutable]\n" |
||||
"load {} Mk4tcl\n" |
||||
"mk::file open exe $::tcl::kitpath -readonly\n" |
||||
"set n [mk::select exe.dirs!0.files name boot.tcl]\n" |
||||
"if {[llength $n] == 1} {\n" |
||||
"array set a [mk::get exe.dirs!0.files!$n]\n" |
||||
"if {![info exists a(contents)]} { error {no boot.tcl file} }\n" |
||||
"if {$a(size) != [string length $a(contents)]} {\n" |
||||
"set a(contents) [zlib decompress $a(contents)]\n" |
||||
"}\n" |
||||
"if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n" |
||||
"uplevel #0 $a(contents)\n" |
||||
"} else {\n" |
||||
"error \"\n $::tcl::kitpath has no VFS data to start up\"\n" |
||||
"}\n" |
||||
"}\n" |
||||
"tclKitPreInit" |
||||
; |
||||
|
||||
/* kitInit.c's initScript: pivot the startup script to an attached main.tcl
|
||||
* when one exists (starpack). A bare runtime carries no main.tcl and the |
||||
* head behaves as a plain tclsh; the trailing bare 'continue' errors the |
||||
* eval on purpose so no pivot happens. */ |
||||
static const char initScript[] = |
||||
"if {[file isfile [file join $::tcl::kitpath main.tcl]]} {\n" |
||||
"set tcl_interactive 0\n" |
||||
"incr argc\n" |
||||
"set argv [linsert $argv 0 $argv0]\n" |
||||
"set argv0 [file join $::tcl::kitpath main.tcl]\n" |
||||
"} else continue\n" |
||||
; |
||||
|
||||
int |
||||
TclKitHead_PreTclInit( |
||||
Tcl_Interp *interp) |
||||
{ |
||||
Tcl_DString encodingName; |
||||
|
||||
Tcl_StaticLibrary(NULL, "Mk4tcl", Mk4tcl_Init, NULL); |
||||
Tcl_StaticLibrary(NULL, "vfs", Vfs_Init, NULL); |
||||
|
||||
/* kitInit.c encoding dance: align the system encoding with the
|
||||
* environment before any vfs path is decoded; boot.tcl re-applies the |
||||
* recorded name once the mounted library's encoding dir is available |
||||
* and remounts (the name may be unavailable until then). */ |
||||
Tcl_GetEncodingNameFromEnvironment(&encodingName); |
||||
if (strcmp(Tcl_DStringValue(&encodingName), Tcl_GetEncodingName(NULL))) { |
||||
Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName)); |
||||
} |
||||
Tcl_SetVar2(interp, "tclkit_system_encoding", NULL, |
||||
Tcl_DStringValue(&encodingName), 0); |
||||
Tcl_DStringFree(&encodingName); |
||||
|
||||
TclSetPreInitScript(preInitCmd); |
||||
return TCL_OK; |
||||
} |
||||
|
||||
int |
||||
TclKitHead_PostTclInit( |
||||
Tcl_Interp *interp) |
||||
{ |
||||
/* kitInit.c's "messy" pivot: Tcl_Main chose the startup script before
|
||||
* Tcl_AppInit ran, so adopt initScript's result as the startup script |
||||
* here; when no script argument was given, drop the argv slot the |
||||
* pivot inserted. */ |
||||
if (Tcl_EvalEx(interp, initScript, -1, TCL_EVAL_GLOBAL) == TCL_OK) { |
||||
const char *encoding = NULL; |
||||
Tcl_Obj *path = Tcl_GetStartupScript(&encoding); |
||||
|
||||
Tcl_SetStartupScript(Tcl_GetObjResult(interp), encoding); |
||||
if (path == NULL) { |
||||
Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]"); |
||||
} |
||||
} |
||||
Tcl_SetVar2(interp, "errorInfo", NULL, "", TCL_GLOBAL_ONLY); |
||||
Tcl_ResetResult(interp); |
||||
return TCL_OK; |
||||
} |
||||
@ -0,0 +1,24 @@
|
||||
#kithead_smoke.tcl (G-101): asserts the mk4 kit-head resolved its OWN attached |
||||
#vfs rather than any on-disk tree - run AS the head's script argument. The |
||||
#suite invokes it with a scrubbed environment; the head sits in out/bin BESIDE |
||||
#a real ../lib/tcl8.6, so the in-exe assertions below are what prove the boot |
||||
#read the container (boot.tcl overrides tclInit entirely - disk never wins). |
||||
|
||||
proc fail {msg} {puts stderr "kithead_smoke FAIL: $msg"; flush stderr; exit 1} |
||||
|
||||
if {![info exists ::tcl::kitpath]} {fail "no ::tcl::kitpath - preinit did not run"} |
||||
set exe [file normalize [info nameofexecutable]] |
||||
set lib [file normalize [info library]] |
||||
if {$lib ne [file join $exe lib tcl$::tcl_version]} { |
||||
fail "info library is $lib - not inside the executable ($exe)" |
||||
} |
||||
if {![file isfile [file join $lib init.tcl]]} {fail "init.tcl not visible inside the mounted library"} |
||||
if {![file isdirectory $exe]} {fail "executable not self-mounted as a directory"} |
||||
if {[catch {package require vfs} v]} {fail "package require vfs (static, via in-kit index): $v"} |
||||
if {[catch {package require Mk4tcl} mv]} {fail "package require Mk4tcl (static): $mv"} |
||||
#a package resolved from the in-kit tm tree |
||||
if {[catch {package require platform} pv]} {fail "package require platform (in-kit tm tree): $pv"} |
||||
#autoloading through the in-kit library (init.tcl auto_load machinery) |
||||
if {[catch {parray tcl_platform} perr]} {fail "auto_load parray via in-kit library: $perr"} |
||||
puts "kithead_smoke OK: [info patchlevel] library-in-exe vfs:$v Mk4tcl:$mv platform:$pv auto_path:[join $auto_path { }]" |
||||
exit 0 |
||||
@ -0,0 +1,116 @@
|
||||
#mk4kit_attach.tcl (G-101): attach the kit-head runtime vfs to a raw head exe. |
||||
#Runs under the suite-built tclsh86t against the installed prefix (vfs::mk4 and |
||||
#Mk4tcl resolve from <prefix>/lib) - the setupvfs.tcl role from the tclkit |
||||
#lineage reshaped: no bootstrapping kit shell is needed because the suite shell |
||||
#plus its installed batteries already carry the whole mk4 write stack. |
||||
# |
||||
#args: -exe <raw head exe> -prefix <install prefix> -boot <boot.tcl> -out <exe> |
||||
# |
||||
#Runtime vfs written into the copied exe: |
||||
# boot.tcl the tracked boot script (lf-normalized) |
||||
# lib/tcl8.6/... the installed script library tree (encoding/ included; |
||||
# the dde/reg package dirs ride along - their dll loads |
||||
# go through mk4vfs's temp-copy mechanism) |
||||
# lib/tcl8/... the tm module tree |
||||
# lib/vfs1.4.2/... tclvfs SCRIPTS only (dll excluded - vfs is STATIC in |
||||
# the head; the pkgIndex 'vfs' entry is rewritten to |
||||
# 'load {} vfs' per the setupvfs .static convention) |
||||
# |
||||
#Text files (.tcl/.txt/.msg/.test) are rewritten with lf endings - crucial for |
||||
#boot-time reads before the vfs is in place (setupvfs.tcl's recorded rule); |
||||
#everything else is byte-copied. mtimes are preserved. |
||||
|
||||
proc fail {msg} {puts stderr "mk4kit_attach FAIL: $msg"; flush stderr; exit 1} |
||||
|
||||
set opts [dict create] |
||||
foreach {k v} $argv { dict set opts $k $v } |
||||
foreach k {-exe -prefix -boot -out} { |
||||
if {![dict exists $opts $k]} {fail "missing required argument $k"} |
||||
} |
||||
set exe [file normalize [dict get $opts -exe]] |
||||
set prefix [file normalize [dict get $opts -prefix]] |
||||
set boot [file normalize [dict get $opts -boot]] |
||||
set out [file normalize [dict get $opts -out]] |
||||
foreach {what path} [list "raw head exe" $exe "install prefix" $prefix "boot script" $boot] { |
||||
if {![file exists $path]} {fail "$what not found: $path"} |
||||
} |
||||
|
||||
if {[catch {package require vfs::mk4} err]} {fail "package require vfs::mk4 (prefix batteries): $err"} |
||||
|
||||
proc copyfile {src dest} { |
||||
file mkdir [file dirname $dest] |
||||
switch -- [file extension $src] { |
||||
.tcl - .txt - .msg - .test { |
||||
set fin [open $src r] |
||||
set fout [open $dest w] |
||||
fconfigure $fout -translation lf |
||||
fcopy $fin $fout |
||||
close $fin |
||||
close $fout |
||||
} |
||||
default { file copy $src $dest } |
||||
} |
||||
catch {file mtime $dest [file mtime $src]} |
||||
} |
||||
|
||||
#copy a tree; excludeglobs match against the path RELATIVE to srcdir |
||||
proc copytree {srcdir destdir {excludeglobs {}}} { |
||||
set srcdir [file normalize $srcdir] |
||||
set pending [list {}] |
||||
while {[llength $pending]} { |
||||
set rel [lindex $pending 0] |
||||
set pending [lrange $pending 1 end] |
||||
set here [expr {$rel eq "" ? $srcdir : [file join $srcdir $rel]}] |
||||
foreach f [glob -nocomplain -tails -dir $here -type f *] { |
||||
set frel [expr {$rel eq "" ? $f : [file join $rel $f]}] |
||||
set skip 0 |
||||
foreach g $excludeglobs { |
||||
if {[string match $g $frel]} {set skip 1; break} |
||||
} |
||||
if {$skip} continue |
||||
copyfile [file join $srcdir $frel] [file join $destdir $frel] |
||||
} |
||||
foreach d [glob -nocomplain -tails -dir $here -type d *] { |
||||
lappend pending [expr {$rel eq "" ? $d : [file join $rel $d]}] |
||||
} |
||||
} |
||||
} |
||||
|
||||
file delete -force $out |
||||
file copy $exe $out |
||||
::vfs::mk4::Mount $out $out |
||||
|
||||
copyfile $boot [file join $out boot.tcl] |
||||
copytree [file join $prefix lib tcl8.6] [file join $out lib tcl8.6] |
||||
copytree [file join $prefix lib tcl8] [file join $out lib tcl8] |
||||
|
||||
#tclvfs scripts: dll out (static in the head), pkgIndex rewritten below |
||||
set vfsdirs [glob -nocomplain -dir [file join $prefix lib] -type d vfs1*] |
||||
if {[llength $vfsdirs] != 1} {fail "expected exactly one <prefix>/lib/vfs1* dir, got: $vfsdirs"} |
||||
set vfsdir [lindex $vfsdirs 0] |
||||
set vfstail [file tail $vfsdir] |
||||
copytree $vfsdir [file join $out lib $vfstail] {*.dll pkgIndex.tcl} |
||||
|
||||
#static-adjusted pkgIndex (setupvfs .static convention): the 'vfs' entry loads |
||||
#the static package instead of sourcing vfs.tcl (which would load the dll); |
||||
#every other entry is kept as installed |
||||
set f [open [file join $vfsdir pkgIndex.tcl] r] |
||||
set idx [read $f] |
||||
close $f |
||||
set rewritten [regsub {package ifneeded vfs ([0-9.]+) \[list source \[file join \$dir vfs\.tcl\]\]} $idx {package ifneeded vfs \1 {load {} vfs}} idx2] |
||||
if {!$rewritten} {fail "pkgIndex.tcl: the 'package ifneeded vfs ... vfs.tcl' entry was not found to rewrite"} |
||||
set f [open [file join $out lib $vfstail pkgIndex.tcl] w] |
||||
fconfigure $f -translation lf |
||||
puts -nonewline $f $idx2 |
||||
close $f |
||||
|
||||
vfs::unmount $out |
||||
|
||||
#verify: reopen raw and confirm boot.tcl at the root (the shape the head's |
||||
#pre-init script looks for) |
||||
mk::file open chk $out -readonly |
||||
set n [mk::select chk.dirs!0.files name boot.tcl] |
||||
mk::file close chk |
||||
if {[llength $n] != 1} {fail "attached image lacks a root boot.tcl"} |
||||
puts "mk4kit_attach OK: $out" |
||||
exit 0 |
||||
Loading…
Reference in new issue