|
|
|
|
@ -1,4 +1,6 @@
|
|
|
|
|
|
|
|
|
|
#source is at /src/vfs/_config/project_main.tcl |
|
|
|
|
|
|
|
|
|
#This main script will consume a first argument of the form dev|os|internal |
|
|
|
|
# or any dash-delimited combination such as dev-os |
|
|
|
|
# |
|
|
|
|
@ -122,6 +124,23 @@ apply { args {
|
|
|
|
|
|
|
|
|
|
return "${plat}-${cpu}" |
|
|
|
|
} |
|
|
|
|
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. |
|
|
|
|
set parts [split [platform_generic] -] |
|
|
|
|
set cpu [lindex $parts end] |
|
|
|
|
set os [join [lrange $parts 0 end-1] -] |
|
|
|
|
if {$os eq "macos"} {set os macosx} |
|
|
|
|
switch -- $cpu { |
|
|
|
|
amd64 {set cpu x86_64} |
|
|
|
|
aarch64 {set cpu arm64} |
|
|
|
|
arm {if {$os eq "macosx"} {set cpu arm64}} |
|
|
|
|
} |
|
|
|
|
return "${os}-${cpu}" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] |
|
|
|
|
@ -607,7 +626,7 @@ apply { args {
|
|
|
|
|
#so we prepend to auto_path using a slightly inefficient method. Should be fine on relatively small list like this |
|
|
|
|
#eventually it should just be something like 'ledit ::auto_path -1 -1 $libfolder' |
|
|
|
|
if {"dev" in $package_modes} { |
|
|
|
|
set platform [::punkboot::platform_generic] |
|
|
|
|
set platform [::punkboot::platform_punk] |
|
|
|
|
#on windows - case differences dont matter - but can stop us finding path in auto_path |
|
|
|
|
#on other platforms, case differences could represent different paths |
|
|
|
|
#review |
|
|
|
|
@ -859,32 +878,114 @@ apply { args {
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#assert arglist has had 'dev|os|os-dev etc' first arg removed if it was present. |
|
|
|
|
if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} { |
|
|
|
|
#called as <executable> dev tclsh or <executable> tclsh |
|
|
|
|
if {[lindex $arglist 0] eq "tclsh"} { |
|
|
|
|
#called as <executable> dev tclsh ?script? ?args...? or <executable> tclsh ... |
|
|
|
|
#we would like to drop through to standard tclsh repl without launching another process |
|
|
|
|
#tclMain.c doesn't allow it unless patched. |
|
|
|
|
#tclMain.c doesn't allow it unless patched (TCLSH_PIPEREPL piperepl patch). |
|
|
|
|
#This branch mirrors the punk_main.tcl tclsh subcommand dispatch (G-118 parity). |
|
|
|
|
set subcommand_arglist [lrange $arglist 1 end] |
|
|
|
|
set ::argv $subcommand_arglist |
|
|
|
|
set ::argc [llength $subcommand_arglist] |
|
|
|
|
if {![info exists ::env(TCLSH_PIPEREPL)]} { |
|
|
|
|
set is_tclsh_piperepl_env_true 0 |
|
|
|
|
set is_tclsh_piperepl_env_true 1 |
|
|
|
|
} else { |
|
|
|
|
if {[string is boolean -strict $::env(TCLSH_PIPEREPL)]} { |
|
|
|
|
set is_tclsh_piperepl_env_true $::env(TCLSH_PIPEREPL) |
|
|
|
|
} else { |
|
|
|
|
set is_tclsh_piperepl_env_true 0 |
|
|
|
|
set is_tclsh_piperepl_env_true 1 |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {!$is_tclsh_piperepl_env_true} { |
|
|
|
|
puts stderr "tcl_interactive: $::tcl_interactive" |
|
|
|
|
puts stderr "stdin: [chan configure stdin]" |
|
|
|
|
puts stderr "Environment variable TCLSH_PIPEREPL is not set or is false or is not a boolean" |
|
|
|
|
if {$is_tclsh_piperepl_env_true && ![info exists ::tclsh(istty)]} { |
|
|
|
|
#runtime lacks the piperepl patch (a patched runtime with the gate open |
|
|
|
|
#publishes ::tclsh(istty) before this script runs). Informational only: |
|
|
|
|
#script-arg and piped forms work regardless; the interactive repl form |
|
|
|
|
#fails fast below. A deliberate TCLSH_PIPEREPL=0 opt-out stays quiet. |
|
|
|
|
puts stderr "note: the runtime doesn't appear to have been compiled with the piperepl patch" |
|
|
|
|
} |
|
|
|
|
#stock tclsh argument forms (tclMain.c): the only recognised leading option is |
|
|
|
|
#'-encoding name fileName' (and only when fileName does not begin with '-'); |
|
|
|
|
#any other leading '-' argument means NO script file - all arguments stay in |
|
|
|
|
#::argv (already set above) and tclsh proceeds to the repl (tty) or stdin |
|
|
|
|
#evaluation (piped). |
|
|
|
|
set tclsh_have_script 0 |
|
|
|
|
set tclsh_encoding "" |
|
|
|
|
if {[llength $subcommand_arglist] >= 3 && [lindex $subcommand_arglist 0] eq "-encoding" && ![string match -* [lindex $subcommand_arglist 2]]} { |
|
|
|
|
set tclsh_encoding [lindex $subcommand_arglist 1] |
|
|
|
|
set tclsh_script [lindex $subcommand_arglist 2] |
|
|
|
|
set tclsh_scriptargs [lrange $subcommand_arglist 3 end] |
|
|
|
|
set tclsh_have_script 1 |
|
|
|
|
} elseif {[llength $subcommand_arglist] && ![string match -* [lindex $subcommand_arglist 0]]} { |
|
|
|
|
set tclsh_script [lindex $subcommand_arglist 0] |
|
|
|
|
set tclsh_scriptargs [lrange $subcommand_arglist 1 end] |
|
|
|
|
set tclsh_have_script 1 |
|
|
|
|
} |
|
|
|
|
if {$tclsh_have_script} { |
|
|
|
|
if {[string match -nocase lib:* $tclsh_script]} { |
|
|
|
|
#scriptlib resolution is a punk facility - the tclsh subcommand keeps plain |
|
|
|
|
#tclsh semantics (no punk modules loaded), so point at the 'script' subcommand |
|
|
|
|
#instead of failing on a literal 'lib:...' path (illegal on windows filesystems |
|
|
|
|
#anyway; reachable via ./lib:... or an absolute path on other platforms). |
|
|
|
|
set exebase [file rootname [file tail [info nameofexecutable]]] |
|
|
|
|
puts stderr "punk tclsh: 'lib:' scriptlib resolution is not supported by the tclsh subcommand (plain tclsh semantics)" |
|
|
|
|
puts stderr " use: $exebase script $tclsh_script ?args...?" |
|
|
|
|
exit 1 |
|
|
|
|
} |
|
|
|
|
set normscript [file normalize $tclsh_script] |
|
|
|
|
if {![file exists $normscript]} { |
|
|
|
|
#not-found gets a clean message ('script' subcommand coherence); errors |
|
|
|
|
#from an existing script keep their full trace |
|
|
|
|
puts stderr "punk tclsh: script file not found: '$normscript'" |
|
|
|
|
exit 1 |
|
|
|
|
} |
|
|
|
|
info script $normscript |
|
|
|
|
set ::argv0 $normscript |
|
|
|
|
set ::argv $tclsh_scriptargs |
|
|
|
|
set ::argc [llength $::argv] |
|
|
|
|
#we are in an apply context here - so we need to uplevel to get the source to work as expected |
|
|
|
|
if {$tclsh_encoding ne ""} { |
|
|
|
|
uplevel 1 [list source -encoding $tclsh_encoding $tclsh_script] |
|
|
|
|
} else { |
|
|
|
|
uplevel 1 [list source $tclsh_script] |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
#default tclsh behaviour is to run the script and exit |
|
|
|
|
#the script can set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run |
|
|
|
|
} else { |
|
|
|
|
#according to env TCLSH_PIPEREPL and our commandline argument - tclsh repl is desired |
|
|
|
|
#check if tclsh/punk has had the piperepl patch applied - in which case tclsh(istty) should exist |
|
|
|
|
if {![info exists ::tclsh(istty)]} { |
|
|
|
|
puts stderr "error: the runtime doesn't appear to have been compiled with the piperepl patch" |
|
|
|
|
#no script file: all arguments (if any) are already in ::argv, matching |
|
|
|
|
#stock tclsh; argv0 is the executable itself, not the kit boot script |
|
|
|
|
set ::argv0 [info nameofexecutable] |
|
|
|
|
if {[info exists ::tclsh(istty)]} { |
|
|
|
|
if {$::tclsh(istty)} { |
|
|
|
|
#tclsh piperepl patch applied - stdin is a tty - we can run the tclsh repl |
|
|
|
|
set ::tclsh(dorepl) 1 |
|
|
|
|
set ::tcl_interactive 1 |
|
|
|
|
} else { |
|
|
|
|
#stdin is not a tty - piped input is evaluated as a script, then exit |
|
|
|
|
set ::tclsh(dorepl) 0 |
|
|
|
|
set ::tcl_interactive 0 |
|
|
|
|
#script on stdin could set ::tclsh(dorepl) 1 to force the tclsh repl after the script has run |
|
|
|
|
set data [read stdin] |
|
|
|
|
uplevel 1 [list eval $data] |
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
#no piperepl machinery (unpatched runtime, or TCLSH_PIPEREPL=0): the |
|
|
|
|
#interactive repl is unavailable. Fail fast on terminal stdin instead of |
|
|
|
|
#blocking in a raw console read (app-punkscript terminal-probe precedent); |
|
|
|
|
#piped/redirected stdin keeps the evaluate-and-exit behaviour. |
|
|
|
|
set conf "" |
|
|
|
|
catch {set conf [chan configure stdin]} |
|
|
|
|
if {[dict exists $conf -inputmode] || [dict exists $conf -mode]} { |
|
|
|
|
set exebase [file rootname [file tail [info nameofexecutable]]] |
|
|
|
|
puts stderr "punk tclsh: the interactive tclsh repl requires a piperepl-capable runtime (this runtime lacks the patch, or TCLSH_PIPEREPL=0)" |
|
|
|
|
puts stderr "usage: <commands> | $exebase tclsh" |
|
|
|
|
puts stderr " or: $exebase tclsh <scriptfile> ?args...?" |
|
|
|
|
exit 1 |
|
|
|
|
} |
|
|
|
|
set ::tcl_interactive 0 |
|
|
|
|
set data [read stdin] |
|
|
|
|
uplevel 1 [list eval $data] |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
set ::tcl_interactive 1 |
|
|
|
|
set ::tclsh(dorepl) 1 |
|
|
|
|
} elseif {[lindex $arglist 0] eq "shell"} { |
|
|
|
|
if {[llength $arglist] == 1} { |
|
|
|
|
package require app_shell |
|
|
|
|
|
