[Starkit] tclkit sans metakit
Tom Poindexter
tpoindex at nyx.net
Wed Sep 7 23:51:24 CEST 2005
On Wed, Sep 07, 2005 at 08:08:52PM +0200, David Welton wrote:
> > You still require some metakit-embedded executable to create
> > the packages, correct? The smallkit is only a runtime
> > solution, IIUC ...
>
> Yes, exactly. It's to deploy something without C++ dependencies that
> is also just a tiny bit smaller - or maybe significantly smaller if
> you are statically linking the C++ libs in.
Nice work on a read-only tclkit. Perhaps a small C coded implementation of
readkit.tcl could be written? I think this has merit especially when I'm
not using a Metakit database with my application.
Linking with C++ is a royal pain. I too have been trying to find a good
way to avoid dynamically linking libstdc++. I have tried various forms of
manually including libstdc++.a on the link command with no luck, until I
ran across this page:
http://www.trilithium.com/johan/2005/06/static-libstdc/
I've hacked up genkit slightly to allow more hooks during various parts of
the tclkit build, generalizing the various Z(tclsupp), Z(tksupp) directives,
and added a 'premake' step to execute additional commands before each
config/make step for each component.
My target machines so far are Linux 2.6 w/ libc6 2.3.x (Ubuntu 5.04), both
x86 and amd64 architectures. With this genkit.local:
set ::libstdc__ [exec g++ -print-file-name=libstdc++.a]
array set Z [list \
kitshmakesuff "-static-libgcc -L." \
kitshpremake "ln -s $::libstdc__ ." \
]
I am able to build tclkit with libstdc++ statically linked:
$ ldd tclkit
libdl.so.2 => /lib/libdl.so.2 (0x0000002a9566c000)
libm.so.6 => /lib/libm.so.6 (0x0000002a9576f000)
libc.so.6 => /lib/libc.so.6 (0x0000002a958f5000)
/lib64/ld-linux-x86-64.so.2 => /lib64/ld-linux-x86-64.so.2 (0x0000002a95556000)
(similar results on 32 bit x86 machine)
I'm attaching my genkit, plus the diff from the current genkit. Tcl 8.4.11
tclkit build from http://equi4.com/pub/tk/tars/
JCW: If you find this patch worthy, please include it in your distributed
genkit.
On a completely unrelated Tclkit matter, I would like a reasonable way to
'locally customize' the auto_path variable. The reason is that I already have
a wealth of Tcl extensions build in /usr/local/lib, but boot.tcl goes out
of its way to make sure that auto_path only points to the tclkit:
in boot.tcl:
uplevel #0 [list source [file join $tcl_library init.tcl]]
# reset auto_path, so that init.tcl's search outside of tclkit is cancelled
set auto_path $tcl_libPath
}
Perhaps this:
set auto_path $tcl_libPath
if {[info exists ::env(TCLKITLIBPATH)]} {
if {$::tcl_platform(platform) eq "windows"} {
set splitchar ";"
} else {
set splitchar ":"
}
foreach path [split $::env(TCLKITLIBPATH) $splitchar] {
lappend auto_path $path
}
}
Oh, and one more Tclkit boot.tcl wish:
if {[string match wishkit* [file tail [info nameofexecutable]] ]} {
package require Tk
}
This would allow me to
ln -s tclkit wishkit
and then when I execute some random Tcl code that assumes 'wish' without a
'package require Tk', I can use the 'wishkit' version.
--
Tom Poindexter
tpoindex at nyx.net
http://www.nyx.net/~tpoindex/
-------------- next part --------------
#!/bin/sh
#
# Generate TclKit - run "tclsh genkit", or see info at end of this script.
#
# Written by Jean-Claude Wippler, as part of Tclkit.
# March 2003 - placed in the public domain by the author.
#
# For latest version of this tool see <http://www.equi4.com/pub/tk/tars/>
# $Id: genkit,v 1.70 2005/09/05 13:07:09 jcw Exp $
# \
TCL_LIBRARY=noarch/lib/tcl8.4; export TCL_LIBRARY
# \
exec "install/`hostname`/bin/tclsh8.4" "$0" ${1+"$@"}
# The following is needed to launch a tclsh or kitsh which does not yet
# have the necessary runtime VFS appended at the end of the executable.
if {![info exists env(TCL_LIBRARY)]} {
set env(TCL_LIBRARY) [file join [pwd] noarch/lib/tcl8.4]
}
# This code is dual-mode, it can be run as tcl or as sh script, which is
# needed to bootstrap this stuff. Make sure Tcl is not too old, though.
package require Tcl 8.0
# This is the base url to fetch source tars from if not already present:
set origurl http://www.equi4.com/pub/tk
# All platform differences are collected below for easy reference.
#
# The idea is quite straightforward:
# - the X array is set up so "$X(anything)" defaults to "anything"
# - the Z array is set up so "$Z(anything)" defaults to ""
# - i.e. "$X(foo)" defaults to "foo" and "$Z(foo)" defaults to ""
# - then for each platform, we can add overrides to alter defaults
#
# NOTE that if the file "genkit.local" exists, it will be sourced before
# actual processing begins - this allows adding more elaborate tweaks.
array set X {}
array set Z {}
switch -glob $tcl_platform(os) {
AIX { array set Z {tclsuff "-Wl,-bshared -lcrypt" tksuff -lIM}
array set X {gcc xlC g++ xlC} }
BSD/OS { array set X {make gmake} }
HP-UX { array set X {gcc cc g++ aCC} }
NetBSD { array set X {. ""} }
OpenBSD { array set Z {vso .1.0}
array set X {. ""} }
#OSF1 { array set X {gcc cc g++ cxx} }
#SunOS { array set X {g++ gcc}; set env(CC) gcc }
SunOS { array set Z {tclsuff "-Wl,-Bstatic -lstdc++"
tksuff "-Wl,-Bstatic -lstdc++"}
set env(CC) gcc }
Windows* { array set Z {s s .exe .exe}
array set X {. "" unix win tclsh8.4 tclsh84s.exe} }
Darwin { array set Z {tclmakesuff
{GENERIC_FLAGS=-UHAVE_STRTOLL\ -UHAVE_STRTOULL\ -UHAVE_LANGINFO \
COMPAT_OBJS=strtoll.o\ strtoull.o} \
stripopt -x}}
default { array set X {} }
}
# this case is too messy to include in the above switch
if {$tcl_platform(os) == "Darwin"} {
array set Z {tclmakesuff
{CFLAGS_OPTIMIZE=-mcpu=G3\ -mtune=G4\ -gfull\ -Os \
CC_SWITCHES=\$(STUB_CC_SWITCHES)\ -mdynamic-no-pic \
LDFLAGS_OPTIMIZE=-Wl,-dead_strip,-s}
stripopt -x
tkdynmakesuff {-o wish TK_SHLIB_LD_EXTRAS=}}
array set X {make {make SHLIB_LD=cc\ -bundle\ \$(LDFLAGS)}}
if {[info exists env(TCLKIT_AQUA)] && "$env(TCLKIT_AQUA)" == "1"} {
append Z(tkdynmakesuff) \
{ TK_SHLIB_LD_EXTRAS=-sectcreate\ __TEXT\ __tk_rsrc\ \$\(TK_RSRC_FILE\)}
set Z(tkconfig) --enable-aqua
}
}
# make $X(anything) default to the value "anything"
proc xdefval {a e op} { if {![info exists ::X($e)]} { set ::X($e) $e } }
trace var X r xdefval
if {[info exists env(EXTRA_MAKE_FLAGS)]} {
set X(make) "$X(make) $env(EXTRA_MAKE_FLAGS)"
}
# make $Z(anything) default to the empty string
proc zdefval {a e op} { if {![info exists ::Z($e)]} { set ::Z($e) "" } }
trace var Z r zdefval
# recursive directory listing, a bit like "ls -lR"
proc listall {dirs} {
while {[llength $dirs] > 0} {
set dir [lindex $dirs 0]
set dirs [lrange $dirs 1 end]
puts "\n$dir:"
set entries [glob -nocomplain [file join $dir *]]
#if {[llength $entries] > 0} { puts "" }
foreach path [lsort $entries] {
if {[file isdir $path]} {
set len " "
set tim " dir"
set suf "/"
lappend dirs $path
} else {
set len [format %9d [file size $path]]
set tim [clock format [file mtime $path] -format {%y/%m/%d %H:%M}]
set suf ""
}
puts " $len $tim [file tail $path]$suf"
}
}
puts ""
}
# copy one file and adjust modification to same as original
proc dupfile {from to} {
set mod [file mtime $from]
if {![file exists $to] || $mod != [file mtime $to]} {
file copy -force $from $to
file mtime $to $mod
}
}
# recursively copy subdirs and files, if modification times differ
proc sync {from to} {
foreach path [glob -nocomplain [file join $from *]] {
set tail [file tail $path]
set dest [file join $to $tail]
if {[file isdir $path]} {
file mkdir $dest
sync $path $dest
} else {
dupfile $path $dest
}
}
}
# return file contents as a string
proc readfile {name {binary 0}} {
set fd [open $name]
if {$binary} {
fconfigure $fd -translation binary -encoding binary
}
set contents [read $fd]
close $fd
return $contents
}
# calculate a simple 4-digit sum of a string
proc simplesum {str} {
set s 0
foreach x [split $str ""] {
binary scan $x c v
set s [expr {7*$s+$v}]
}
return [format %04d [expr {abs($s) % 9000 + 1000}]]
}
# calculate an md5 checksum for a file
proc md5sum {name} {
return [lindex [exec md5sum -b $name] 0]
}
# create a tag for a file and delete it
proc tagfile {name} {
if {[catch { md5sum $name } tag]} {
set tag ""
} else {
lappend tag [file size $name] [file mtime $name]
}
file delete name
return [linsert $tag 0 $name]
}
# compare tag, if same then restore its modification time
proc untagfile {tag} {
foreach {nm md sz mtime} $tag break
if {[file exists $nm] && [file size $nm] == $sz && [md5sum $nm] == $md} {
file mtime $nm $mtime
}
}
# convert seconds to readable date/time format
proc timestamp {{now ""} {sep -}} {
if {$now == ""} { set now [clock seconds] }
return [clock format $now -format "%Y/%m/%d$sep%H:%M:%S"]
}
# convert possibly globbed path specifier to real name, if unique
proc unglob {path} {
set f [glob -nocomplain $path]
if {[llength $f] == 1} { set path [lindex $f 0] }
return $path
}
# execute external command
proc run {args} {
puts -nonewline [format { %-30.30s... } $args]
flush stdout
puts $::F "\nRUN: $args\n"
flush $::F
set err [catch { eval exec $args >>& $::P/out/$::H/$::target } msg]
seek $::F 0 end
if {$err == 0} {
puts "ok"
} else {
puts "FAILED:"
puts "-[string repeat {=-} 39]\n$args\n-[string repeat {#-} 39]"
puts $::F "FAILED:\n$msg"
return -code error $msg
}
}
# run a configure script
proc config {dir args} {
if {![file exists Makefile]} {
eval [list run sh [file join ../../../src $dir configure] \
--prefix=$::P/noarch --exec-prefix=$::I] $args
}
}
# parse and load tcl/tk config files into global vars
proc loadconf {name} {
set vars {}
foreach x {AR DBGX LDFLAGS LIBS LIB_RUNTIME_DIR NODOT_VERSION VERSION} {
global $x
set $x ""
}
set fd [open $name]
while {[gets $fd line] >= 0} {
if {[regexp {^(\w+)=$} $line - name]} {
set value ""
} elseif {![regexp {^(\w+)='(.*)'$} $line - name value]} {
continue
}
global $name
set $name [subst $value]
lappend vars $name
}
close $fd
return $vars
}
# summarize all available results
proc summarize {aref {modules {kitsh itcldyn tkdyn builds}}} {
upvar $aref summary
array set targets {}
array set platforms {}
foreach file [glob -nocomplain out/*/*] {
set platform [lindex [file split $file] 1]
set platforms($platform) 1
set target [lindex [file split $file] 2]
set targets($target) 1
set log [readfile $file]
switch -regexp $log {
"\nERROR:" { set status ERR }
"\nEND\." { set status (+) }
default { set status BAD }
}
set ${target}($platform) $status
array set info:$platform {}
if {$target == "tcl"} {
foreach line [split $log \n] {
if {[regexp {^tcl_platform\((\w+)\)\s+= (.*)} $line - key value]} {
set info:${platform}($key) $value
}
}
}
}
array set files {}
foreach {target mask} {
kit kit{,.exe}
kitsh kitsh{,.exe}
mkcpp lib/libmk4.{so,sl,dylib,dll}
mktcl lib/Mk4tcl.{so,sl,dylib,dll}
itcldyn lib/itcl3.3/libitcl3{,.}3.{so,so.1.0,sl,dylib,dll}
tkdyn lib/libtk8{,.}4.{so,so.1.0,sl,dylib,dll}
tcl bin/tclsh8{,.}4{,s.exe}
} {
array set $target {}
foreach file [glob -nocomplain install/*/$mask] {
set platform [lindex [file split $file] 1]
set mtime [timestamp [file mtime $file]]
lappend ${target}($platform) $mtime [file size $file]b
lappend files($platform) $target
}
}
foreach target [lsort [array names targets]] {
foreach {k v} [array get $target] {
set info:${k}($target) $v
}
}
set platlist {}
array set summary {}
foreach platform [lsort [array names platforms]] {
if {[info exists info:${platform}(machine)] > 0} {
lappend platlist $platform
set summary($platform,id) [simplesum $platform]
foreach k "machine os osVersion wordSize byteOrder $modules" {
set x {}
if {[info exists info:${platform}($k)]} {
set x [set info:${platform}($k)]
switch $k {
byteOrder { regsub {Endian} $x {} x }
}
regsub {^\(\+\)} $x {OK} x
regsub {^OK } $x {} x
if {$k != "builds"} { set x [lindex $x 0] }
if {[regsub {^20(0\d/\d\d/\d\d)-.*$} $x {\1} x]} {
switch $k kitsh - itcldyn - tkdyn {
set v [string map {kitsh sh tkdyn tdyn itcldyn idyn} $k]
lappend info:${platform}(builds) $v
}
}
}
set summary($platform,$k) $x
}
}
}
return $platlist
}
# Copy a URL to a file and print meta-data
# (this sample code was adapted from the Tcl manual page)
proc origfetch {file} {
package require http
if {[info exists ::env(http_proxy)]} {
regexp {//(.*):(.*)} $::env(http_proxy) m h p
http::config -proxyhost $h -proxyport $p
}
puts -nonewline " fetching $file ... "
flush stdout
set fd [open $file w]
set t [http::geturl $::origurl/$file -channel $fd -blocksize 4096]
close $fd
scan [http::code $t] {HTTP/%f %d} ver ncode
puts [http::status $t]
http::cleanup $t
if {$ncode != 200 || [file size $file] == 0} {
file delete $file
}
}
namespace eval commands {
# Step 1: acquire and unpack all the necessary sources
# The goal is to end up with a src/ dir and tcl/tk/etc dirs in it
proc A {args} {
global origurl
file mkdir src
set packages $args
if {[llength $packages] == 0} {
set packages {tcl tk itcl mk vfs kit zlib}
}
foreach pkg $packages {
if {[file exists src/$pkg]} {
continue
}
set cvs "cvs/$pkg"
if {[file isdir $cvs]} {
puts " symlinking to $cvs"
cd src
exec ln -s ../$cvs $pkg
cd ..
continue
}
set tar "tars/$pkg.tar.gz"
if {![file isfile $tar]} {
file mkdir tars
origfetch $tar
}
if {[file isfile $tar]} {
puts " unpacking $tar"
cd src
# on HP-UX, gzip|tar generates a non-zero status code
# ignore it, check for the result being created instead
catch { exec gzip -d < ../$tar | tar xf - }
if {![file isdirectory $pkg]} {
puts stderr "$pkg: ungzip or untar failed"
}
cd ..
continue
}
puts stderr "$pkg: not found"
}
}
# Step 2: build all the components of TclKit
proc B {args} {
global target F H P B I S X Z
if {[llength $args] == 0} {
set args {zlib vfs mk kitsh itcldyn tkdyn}
}
set P [pwd]
set B $P/build/$H
set I $P/install/$H
set S $P/src
# special case configs, make the 'dyn' versions of Z stuff same as non-dyn
if {$Z(tkdynconfig) ne ""} {set Z(tkdynconfig) $Z(tkconfig)}
if {$Z(itcldynconfig) ne ""} {set Z(itcldynconfig) $Z(itclconfig)}
if {$Z(tkdynmakesuff) ne ""} {set Z(tkdynmakesuff) $Z(tkmakesuff)}
if {$Z(itcldynmakesuff) ne ""} {set Z(itcldynmakesuff) $Z(itclmakesuff)}
foreach target $args {
puts " $target:"
file mkdir out/$H
set F [open $P/out/$H/$target w]
fconfigure $F -buffering line
if {[catch {
file mkdir $B/$target
cd $B/$target
if {$Z(${target}premake) ne ""} {
catch {eval run $Z(${target}premake)}
}
set pkgconfig $Z(${target}config)
set makesuff $Z(${target}makesuff)
switch $target {
tcl {
eval config tcl/$X(unix) --disable-shared $pkgconfig
#run $X(make) genstubs
eval run $X(make) binaries \
LD_SEARCH_FLAGS= CC_SEARCH_FLAGS= TCL_LIBRARY= TCL_PACKAGE_PATH= \
$makesuff
file mkdir $I
eval run $X(make) install-binaries install-libraries
# results have been installed so tclsh can be used
run $I/bin/$X(tclsh8.4) << "parray tcl_platform"
}
tk {
eval config tk/$X(unix) --with-tcl=$B/tcl --disable-shared \
$pkgconfig
#run $X(make) genstubs
eval run $X(make) binaries LD_SEARCH_FLAGS= CC_SEARCH_FLAGS= \
TK_LIBRARY= $makesuff
}
tkdyn {
eval config tk/unix --with-tcl=$B/tcl $pkgconfig
#run $X(make) genstubs
close [open wish w]
eval run $X(make) binaries LD_SEARCH_FLAGS= CC_SEARCH_FLAGS= \
TK_LIBRARY= $makesuff
file mkdir $I
eval run $X(make) install-binaries $makesuff
# don't keep the installed wish, just the shared lib
file delete $I/bin/wish8.4
# results have been installed so shared lib can be packaged later
}
itcl {
eval config itcl/itcl --with-tcl=$B/tcl --disable-shared $pkgconfig
eval run $X(make) binaries ITCL_LIBRARY= $makesuff
}
itcldyn {
eval config itcl/itcl --with-tcl=$B/tcl $pkgconfig
eval run $X(make) binaries ITCL_LIBRARY= $makesuff
file mkdir $I
eval run $X(make) install-binaries
}
mk {
eval config mk/unix --with-tcl=$S/tcl/generic --disable-shared \
$pkgconfig
eval run $X(make) Mk4tcl.a $makesuff
}
vfs {
eval config vfs --with-tcl=$B/tcl --disable-shared $pkgconfig
eval run $X(make) binaries $makesuff
}
zlib {
# copy all files to build area, it doesn't build in another spot
sync $S/zlib .
eval config [pwd] $pkgconfig
eval run $X(make) libz.a $makesuff
}
thrive {
eval config thrive --with-tcl=$B/tcl --disable-shared $pkgconfig
eval run $X(make) binaries $makesuff
}
kitro -
kitsh -
kit {
# copy all files to build area, it doesn't build in another spot
sync $S/kit .
eval global [loadconf $B/tcl/tclConfig.sh]
# work around a quoting bug when 64-bit ints are supported
regsub {long long} $TCL_DEFS {long\ long} TCL_DEFS
set D [list -DNDEBUG -DTCL_LOCAL_APPINIT=TclKit_AppInit]
set O [list -I. -I$S/tcl/generic -I$S/mk/include -I$S/zlib]
set L [list ../tcl/libtcl8$X(.)4$Z(s).a ../vfs/libvfs1$X(.)3.a \
../zlib/libz.a]
if {$target == "kitro"} {
lappend L [glob ../thrive/libthrive*.a]
} else {
lappend L ../mk/Mk4tcl.a
}
eval lappend L $TCL_LD_FLAGS
switch $target {
kitro {
lappend D -DKIT_READONLY
eval lappend L $TCL_LIB_SPEC $TCL_LIBS $Z(tclsuff)
set X(g++) $X(gcc) ;# no need for C++ anymore
}
kitsh {
eval lappend L $TCL_LIB_SPEC $TCL_LIBS $Z(tclsuff)
}
kit {
eval global [loadconf $B/tk/tkConfig.sh]
lappend D -DKIT_INCLUDES_TK -DKIT_INCLUDES_ITCL
eval lappend O -I$S/tk/generic $TK_XINCLUDES
lappend L ../itcl/libitcl3$X(.)3.a
eval lappend L $TK_BUILD_LIB_SPEC $TK_LIBS $Z(tksuff)
}
}
append target $Z(.exe)
eval run $X(gcc) -c $O $D $TCL_DEFS $TCL_CFLAGS_OPTIMIZE \
[glob src/*.c] [list $S/tcl/unix/tclAppInit.c]
eval run $X(g++) -o $target [glob *.o] $L $makesuff
run strip $target
file mkdir $I
file delete $I/$target
file copy $target $I
run ls -l $I
}
}
puts $F "\nEND."
} err]} {
puts " ERROR: $err"
puts $F "\nERROR: $::errorInfo"
}
close $F
cd $P
}
puts " Done."
}
# Step 3: collect results
proc C {} {
global H
exec tar cf - install/$H out/$H | gzip >result-$H.tar.gz
}
# Step 4: create a dummy tclkit and try it
proc D {} {
global H X Z
set I install/$H
set E [info sharedlibext]
set R tars/runtime.kit
if {![file exists $R]} { origfetch $R }
exec cat $I/kitsh $R >dummy-$H
file attributes dummy-$H -permissions +x
set script [string map [list @H $H @I $I @E $E$Z(vso) @. $X(.)] {
puts " info loaded = [info loaded]"
puts " tclkit_version = $vfs::tclkit_version"
parray tcl_platform
load @I/lib/itcl3.3/libitcl3 at .3@E
puts " package Itcl = [package require Itcl]"
if {[info exists env(DISPLAY)] && $env(DISPLAY) != ""} {
load @I/lib/libtk8 at .4@E
puts " package Tk = [package require Tk]"
pack [label .l -text " @H says HELLO! "] -padx 50 -pady 50
} else {
puts " *** DISPLAY has not been defined, skipping Tk test ***"
}
after 3000 destroy .
puts " running [file tail [info nameofexe]]"
}]
exec ./dummy-$H <<$script >@stdout 2>@stderr
}
# Step 5: extended version includes incrtcl and tk
proc E {} {
global H X Z
set I install/$H
set E [info sharedlibext]
set R tars/runtime.kit
if {![file exists $R]} { origfetch $R }
file copy -force $I/kitsh tclkit-$H
file attributes tclkit-$H -permissions +x
# needed for OpenBSD, which leaves them as 0555
file attributes $I/lib/itcl3.3/libitcl3$X(.)3$E$Z(vso) -permissions +w
file attributes $I/lib/libtk8$X(.)4$E$Z(vso) -permissions +w
# MacOS X needs to strip shared libs with -x
eval exec strip $Z(stripopt) $I/lib/itcl3.3/libitcl3$X(.)3$E$Z(vso)
eval exec strip $Z(stripopt) $I/lib/libtk8$X(.)4$E$Z(vso)
# the following approach makes sure the result is optimally packed
set script [string map [list @H $H @I $I @E $E @R $R @. $X(.) @v $Z(vso)] {
set db [vfs::mk4::Mount @R @R -readonly]
vfs::attributes @R -state translucent
file copy @I/lib/itcl3.3/libitcl3 at .3@E at v @R/lib/itcl3.3/libitcl3.3 at E
file copy @I/lib/libtk8 at .4@E at v @R/lib/tk8.4/libtk8.4 at E
set fd [open tclkit- at H a]
mk::file save $db $fd
close $fd
vfs::unmount @R
}]
# need to run from dummy, because VFS needs Mk4tcl
exec ./dummy-$H <<$script
puts " tclkit-$H: [file size dummy-$H] -> [file size tclkit-$H]"
}
# Private use: freeze build results for packaging
proc F {} {
file mkdir parts
foreach pf [summarize ia] {
if {$ia($pf,builds) == ""} continue
set info(seq) [simplesum $pf]
set info(name) [string tolower $ia($pf,os)-$ia($pf,machine)]
regsub -all {[^a-z0-9-]} $info(name) {} info(name)
set iprefix install/$pf
set oprefix parts/$info(name).$info(seq)
set lib $iprefix/lib
set sfx ".{so,so.1.0,sl,dylib,dll}"
set tag [tagfile $oprefix,in]
foreach build $ia($pf,builds) {
switch $build {
sh {
dupfile $iprefix/kitsh $oprefix,sh
}
idyn {
dupfile [unglob $lib/itcl3.3/libitcl3{,.}3$sfx] $oprefix,it
}
tdyn {
dupfile [unglob $lib/libtk8{,.}4$sfx] $oprefix,tk
}
full {
dupfile $iprefix/kit $oprefix,ui
}
}
}
foreach x [glob -nocomplain $oprefix,*] {
regsub {.*,} $x {} k
if {$k != "in"} {
set info($k) [list [file mtime $x] [md5sum $x] [file size $x]]
file attributes $x -permissions 0755
}
}
foreach x [array names ia $pf,*] {
set k [lindex [split $x ,] 1]
switch $k kit - kitsh - idyn - tdyn continue
set info($k) $ia($x)
}
foreach x {tcl tk} {
if {[file exists $iprefix/lib/${x}Config.sh]} {
foreach y [loadconf $iprefix/lib/${x}Config.sh] {
set info($y) [string trim [set ::$y]]
}
}
}
set fd [open $oprefix,in w]
foreach x [lsort [array names info]] {
puts $fd [list $x $info($x)]
}
close $fd
untagfile $tag
unset info
}
}
# Private use: generate all builds
proc G {} {
file mkdir head
foreach x [glob -nocomplain parts/*,in] {
regexp {.*/(.*-.*)\.(\d+),in} $x - pf seq
regsub {,in} $x {} prefix
array set info [readfile $x]
set mtime [file mtime $x]
set dll $info(TCL_SHLIB_SUFFIX)
if {[info exist info(sh)]} {
if {[info exist info(tk)]} {
set f head/$pf.$seq-dyn.bin
set g ""
exec cat $prefix,sh dist/tars/runtime.kit > $f
vfs::mk4::Mount $f kit -nocommit
dupfile $prefix,tk kit/lib/tk8.4/libtk8.4$dll
if {[info exist info(it)]} {
dupfile $prefix,it kit/lib/itcl3.3/libitcl3.3$dll
}
vfs::unmount kit
} else {
set f head/$pf.$seq-sh.bin
set g -sh
exec cat $prefix,sh dist/tars/runtime$g.kit > $f
}
if {$mtime < [file mtime dist/tars/runtime$g.kit]} {
set mtime [file mtime dist/tars/runtime$g.kit]
}
file mtime $f $mtime
file attributes $f -permissions 0755
}
if {[info exist info(ui)]} {
set f head/$pf.$seq.bin
exec cat $prefix,ui dist/tars/runtime.kit > $f
file attributes $f -permissions 0755
if {$mtime < [file mtime dist/tars/runtime.kit]} {
set mtime [file mtime dist/tars/runtime.kit]
}
file mtime $f $mtime
}
unset info
}
}
# List the contents of a starkit
proc L {doc} {
set tail [file tail $doc]
# no changes requested, just list full contents
vfs::mk4::Mount $doc $tail -readonly
listall $tail
vfs::unmount $tail
}
# Merge parts with runtime VFS
proc M {path {ext so}} {
regexp {^parts/(.*)\.(\d\d\d\d),in$} $path - name id
file copy -force parts/$name.$id,sh head/$name.$id
set script [string map [list @N $name @I $id @E $ext] {
set db [vfs::mk4::Mount runtime.kit runtime -readonly]
catch { vfs::attributes runtime -state translucent }
file copy parts/@N. at I,it runtime/lib/itcl3.3/libitcl3.3. at E
file copy parts/@N. at I,tk runtime/lib/tk8.4/libtk8.4. at E
set fd [open head/@N. at I a]
mk::file save $db $fd
close $fd
vfs::unmount runtime
puts "Output in: head/@N. at I"
}]
exec tclkit <<$script >@stdout 2>@stderr
}
# Packager, merges one or more files/dirs into a starkit
proc P {exe args} {
set tail [file tail $exe]
if {[llength $args] < 1} {
puts "usage: $::argv0 P exefile dir ?...?"
exit 1
}
vfs::mk4::Mount $exe $exe -nocommit
foreach addin $args {
if {[file isdir $addin]} {
sync $addin $exe
} else {
vfs::mk4::Mount $addin $addin -readonly
sync $addin $exe
vfs::unmount $addin
}
}
vfs::unmount $exe
}
# Produce a build status summary as a concise HTML table
proc S {{outfile status.html}} {
set modules {tcl mk vfs kitsh itcldyn tkdyn builds}
set fd [open $outfile w]
puts $fd {<html><head><title>TclKit Build Status</title>
<STYLE TYPE="text/css"><!--
BODY,TD { font-family: verdana,sans-serif; font-size: 8pt; }
TH { font-family: verdana,sans-serif; font-size: 9pt; font-weight: bold; }
//--></STYLE></head>}
puts $fd "<body><h3>TclKit build status as of [timestamp]</h3>"
puts $fd "<table border=0 cellpadding=2 cellspacing=1 bgcolor=#cccccc>"
set tags "os machine version word endian $modules id host"
puts $fd "<tr><th bgcolor=#ffffff>[join $tags {</th><th bgcolor=#ffffff>}]</td></tr>"
foreach pf [summarize info $modules] {
set all($info($pf,os),$info($pf,machine),$info($pf,osVersion),$pf) $pf
}
set lastfull {}
foreach x [lsort -dictionary [array names all]] {
set pf $all($x)
set show {}
set full {}
set blanking 1
foreach k "os machine osVersion wordSize \
byteOrder $modules id" l $lastfull {
set x $info($pf,$k)
set x [string range $x 0 19]
regsub -all { } $x {\ } x
regsub {^ERR} $x {<font color=red>ERR</font>} x
lappend full $x
if {$blanking && $x == $l} { set x "" } else { set blanking 0 }
lappend show $x
}
lappend show [lindex [split $pf .] 0]
puts $fd "<tr><td bgcolor=#ffffff>[join $show {</td><td bgcolor=#ffffff>}]</td></tr>"
set lastfull $full
}
puts $fd "</table></body></html>"
close $fd
}
# Copy the VFS tail (i.e. all MK data) to a separate file
# The result is like perfect snow... freshly packed :)
proc T {infile outfile} {
mk::file open db $infile -readonly
set fd [open $outfile w]
mk::file save db $fd
close $fd
mk::file close db
puts [exec ls -lG $outfile]
}
}
set cmd [lindex $argv 0]
set argv [lrange $argv 1 end]
switch -- $cmd G - L - P {
# these use VFS, make sure it's available
set v [package require mk4vfs]
# fix bug in two mk4vfs revs (needed when "mkfile" and "local" differ)
switch $v 1.0 - 1.1 {
proc vfs::mk4::Mount {mkfile local args} {
set db [eval [list ::mk4vfs::_mount $local $mkfile] $args]
::vfs::filesystem mount $local [list ::vfs::mk4::handler $db]
::vfs::RegisterMount $local [list ::vfs::mk4::Unmount $db]
return $db
}
proc mk4vfs::mount {local mkfile args} {
uplevel [list ::vfs::mk4::Mount $mkfile $local] $args
}
}
}
set H [exec hostname]
if {[file exists genkit.local]} { source genkit.local }
# avoid confusing errors further down the line
if {$H == ""} {
puts "genkit requires a hostname, this machine does not have one."
exit 1
}
if {[namespace eval commands [list info procs $cmd]] == ""} {
puts "Generate TclKit - by Jean-Claude Wippler <www.equi4.com>
(a tool to help build TclKit runtime releases)
Usage: $::argv0 cmd ?args...?
Cmd: A = Step 1: acquire source packages
B = Step 2: build binaries
C = Step 3: collect results
D = Step 4: create a dummy tclkit and try it
E = Step 5: extended version includes incrtcl and tk
A few more commands, not for general use:
F = Freeze build results for packaging
G = Generate tclkit* executables
L = List contents of a VFS file
M = Merge parts with runtime VFS
P = Merge files and dirs into one package
S = Generate an HTML build summary
T = Extract the VFS tail to a separate file
"
exit
}
if {[catch { namespace eval commands [concat $cmd $argv] } msg]} {
puts stderr $msg
exit 1
}
# vim: ft=tcl
-------------- next part --------------
215a216
> puts $::F "FAILED:\n$msg"
424a426,431
> # special case configs, make the 'dyn' versions of Z stuff same as non-dyn
> if {$Z(tkdynconfig) ne ""} {set Z(tkdynconfig) $Z(tkconfig)}
> if {$Z(itcldynconfig) ne ""} {set Z(itcldynconfig) $Z(itclconfig)}
> if {$Z(tkdynmakesuff) ne ""} {set Z(tkdynmakesuff) $Z(tkmakesuff)}
> if {$Z(itcldynmakesuff) ne ""} {set Z(itcldynmakesuff) $Z(itclmakesuff)}
>
435a443,448
> if {$Z(${target}premake) ne ""} {
> catch {eval run $Z(${target}premake)}
> }
> set pkgconfig $Z(${target}config)
> set makesuff $Z(${target}makesuff)
>
439c452
< config tcl/$X(unix) --disable-shared
---
> eval config tcl/$X(unix) --disable-shared $pkgconfig
443c456
< $Z(tclmakesuff)
---
> $makesuff
451c464,465
< config tk/$X(unix) --with-tcl=$B/tcl --disable-shared $Z(tkconfig)
---
> eval config tk/$X(unix) --with-tcl=$B/tcl --disable-shared \
> $pkgconfig
454c468
< TK_LIBRARY=
---
> TK_LIBRARY= $makesuff
458c472
< config tk/unix --with-tcl=$B/tcl $Z(tkconfig)
---
> eval config tk/unix --with-tcl=$B/tcl $pkgconfig
462c476
< TK_LIBRARY= $Z(tkdynmakesuff)
---
> TK_LIBRARY= $makesuff
464c478
< eval run $X(make) install-binaries $Z(tkdynmakesuff)
---
> eval run $X(make) install-binaries $makesuff
471,472c485,486
< config itcl/itcl --with-tcl=$B/tcl --disable-shared
< eval run $X(make) binaries ITCL_LIBRARY=
---
> eval config itcl/itcl --with-tcl=$B/tcl --disable-shared $pkgconfig
> eval run $X(make) binaries ITCL_LIBRARY= $makesuff
476,477c490,491
< config itcl/itcl --with-tcl=$B/tcl
< eval run $X(make) binaries ITCL_LIBRARY=
---
> eval config itcl/itcl --with-tcl=$B/tcl $pkgconfig
> eval run $X(make) binaries ITCL_LIBRARY= $makesuff
483,484c497,499
< config mk/unix --with-tcl=$S/tcl/generic --disable-shared
< eval run $X(make) Mk4tcl.a
---
> eval config mk/unix --with-tcl=$S/tcl/generic --disable-shared \
> $pkgconfig
> eval run $X(make) Mk4tcl.a $makesuff
488,489c503,504
< config vfs --with-tcl=$B/tcl --disable-shared
< eval run $X(make) binaries
---
> eval config vfs --with-tcl=$B/tcl --disable-shared $pkgconfig
> eval run $X(make) binaries $makesuff
495,496c510,511
< config [pwd]
< eval run $X(make) libz.a
---
> eval config [pwd] $pkgconfig
> eval run $X(make) libz.a $makesuff
500,501c515,516
< config thrive --with-tcl=$B/tcl --disable-shared
< eval run $X(make) binaries
---
> eval config thrive --with-tcl=$B/tcl --disable-shared $pkgconfig
> eval run $X(make) binaries $makesuff
548c563
< eval run $X(g++) -o $target [glob *.o] $L
---
> eval run $X(g++) -o $target [glob *.o] $L $makesuff
More information about the Starkit
mailing list