aboutsummaryrefslogtreecommitdiffstats
path: root/contrib/tcl/library
diff options
context:
space:
mode:
authorPoul-Henning Kamp <phk@FreeBSD.org>1996-06-26 06:06:43 +0000
committerPoul-Henning Kamp <phk@FreeBSD.org>1996-06-26 06:06:43 +0000
commit403acdc0da2969f284b74b720692585bfc676190 (patch)
tree4d70f77f44120e6541d1418223baf06562774975 /contrib/tcl/library
downloadsrc-403acdc0da2969f284b74b720692585bfc676190.tar.gz
src-403acdc0da2969f284b74b720692585bfc676190.zip
Tcl 7.5, various makefiles will be updated to use these sources as soonvendor/tcl/7.5
as I get these back down to my machine.
Notes
Notes: svn path=/vendor/tcl/dist/; revision=16756 svn path=/vendor/tcl/7.5/; revision=16758; tag=vendor/tcl/7.5
Diffstat (limited to 'contrib/tcl/library')
-rw-r--r--contrib/tcl/library/init.tcl531
-rw-r--r--contrib/tcl/library/ldAout.tcl224
-rw-r--r--contrib/tcl/library/license.terms32
-rw-r--r--contrib/tcl/library/parray.tcl29
-rw-r--r--contrib/tcl/library/tclIndex19
5 files changed, 835 insertions, 0 deletions
diff --git a/contrib/tcl/library/init.tcl b/contrib/tcl/library/init.tcl
new file mode 100644
index 000000000000..7ffc647ed5d6
--- /dev/null
+++ b/contrib/tcl/library/init.tcl
@@ -0,0 +1,531 @@
+# init.tcl --
+#
+# Default system startup file for Tcl-based applications. Defines
+# "unknown" procedure and auto-load facilities.
+#
+# SCCS: @(#) init.tcl 1.54 96/04/21 13:55:08
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+if {[info commands package] == ""} {
+ error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
+}
+package require -exact Tcl 7.5
+if [catch {set auto_path $env(TCLLIBPATH)}] {
+ set auto_path ""
+}
+if {[lsearch -exact $auto_path [info library]] < 0} {
+ lappend auto_path [info library]
+}
+package unknown tclPkgUnknown
+if {[info commands exec] == ""} {
+ # Some machines, such as the Macintosh, do not have exec
+ set auto_noexec 1
+}
+set errorCode ""
+set errorInfo ""
+
+# unknown --
+# This procedure is called when a Tcl command is invoked that doesn't
+# exist in the interpreter. It takes the following steps to make the
+# command available:
+#
+# 1. See if the autoload facility can locate the command in a
+# Tcl script file. If so, load it and execute it.
+# 2. If the command was invoked interactively at top-level:
+# (a) see if the command exists as an executable UNIX program.
+# If so, "exec" the command.
+# (b) see if the command requests csh-like history substitution
+# in one of the common forms !!, !<number>, or ^old^new. If
+# so, emulate csh's history substitution.
+# (c) see if the command is a unique abbreviation for another
+# command. If so, invoke the command.
+#
+# Arguments:
+# args - A list whose elements are the words of the original
+# command, including the command name.
+
+proc unknown args {
+ global auto_noexec auto_noload env unknown_pending tcl_interactive
+ global errorCode errorInfo
+
+ # Save the values of errorCode and errorInfo variables, since they
+ # may get modified if caught errors occur below. The variables will
+ # be restored just before re-executing the missing command.
+
+ set savedErrorCode $errorCode
+ set savedErrorInfo $errorInfo
+ set name [lindex $args 0]
+ if ![info exists auto_noload] {
+ #
+ # Make sure we're not trying to load the same proc twice.
+ #
+ if [info exists unknown_pending($name)] {
+ unset unknown_pending($name)
+ if {[array size unknown_pending] == 0} {
+ unset unknown_pending
+ }
+ return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
+ }
+ set unknown_pending($name) pending;
+ set ret [catch {auto_load $name} msg]
+ unset unknown_pending($name);
+ if {$ret != 0} {
+ return -code $ret -errorcode $errorCode \
+ "error while autoloading \"$name\": $msg"
+ }
+ if ![array size unknown_pending] {
+ unset unknown_pending
+ }
+ if $msg {
+ set errorCode $savedErrorCode
+ set errorInfo $savedErrorInfo
+ set code [catch {uplevel $args} msg]
+ if {$code == 1} {
+ #
+ # Strip the last five lines off the error stack (they're
+ # from the "uplevel" command).
+ #
+
+ set new [split $errorInfo \n]
+ set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
+ return -code error -errorcode $errorCode \
+ -errorinfo $new $msg
+ } else {
+ return -code $code $msg
+ }
+ }
+ }
+ if {([info level] == 1) && ([info script] == "") \
+ && [info exists tcl_interactive] && $tcl_interactive} {
+ if ![info exists auto_noexec] {
+ if [auto_execok $name] {
+ set errorCode $savedErrorCode
+ set errorInfo $savedErrorInfo
+ return [uplevel exec >&@stdout <@stdin $args]
+ }
+ }
+ set errorCode $savedErrorCode
+ set errorInfo $savedErrorInfo
+ if {$name == "!!"} {
+ return [uplevel {history redo}]
+ }
+ if [regexp {^!(.+)$} $name dummy event] {
+ return [uplevel [list history redo $event]]
+ }
+ if [regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new] {
+ return [uplevel [list history substitute $old $new]]
+ }
+ set cmds [info commands $name*]
+ if {[llength $cmds] == 1} {
+ return [uplevel [lreplace $args 0 0 $cmds]]
+ }
+ if {[llength $cmds] != 0} {
+ if {$name == ""} {
+ return -code error "empty command name \"\""
+ } else {
+ return -code error \
+ "ambiguous command name \"$name\": [lsort $cmds]"
+ }
+ }
+ }
+ return -code error "invalid command name \"$name\""
+}
+
+# auto_load --
+# Checks a collection of library directories to see if a procedure
+# is defined in one of them. If so, it sources the appropriate
+# library file to create the procedure. Returns 1 if it successfully
+# loaded the procedure, 0 otherwise.
+#
+# Arguments:
+# cmd - Name of the command to find and load.
+
+proc auto_load cmd {
+ global auto_index auto_oldpath auto_path env errorInfo errorCode
+
+ if [info exists auto_index($cmd)] {
+ uplevel #0 $auto_index($cmd)
+ return [expr {[info commands $cmd] != ""}]
+ }
+ if ![info exists auto_path] {
+ return 0
+ }
+ if [info exists auto_oldpath] {
+ if {$auto_oldpath == $auto_path} {
+ return 0
+ }
+ }
+ set auto_oldpath $auto_path
+ for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {
+ set dir [lindex $auto_path $i]
+ set f ""
+ if [catch {set f [open [file join $dir tclIndex]]}] {
+ continue
+ }
+ set error [catch {
+ set id [gets $f]
+ if {$id == "# Tcl autoload index file, version 2.0"} {
+ eval [read $f]
+ } elseif {$id == "# Tcl autoload index file: each line identifies a Tcl"} {
+ while {[gets $f line] >= 0} {
+ if {([string index $line 0] == "#")
+ || ([llength $line] != 2)} {
+ continue
+ }
+ set name [lindex $line 0]
+ set auto_index($name) \
+ "source [file join $dir [lindex $line 1]]"
+ }
+ } else {
+ error "[file join $dir tclIndex] isn't a proper Tcl index file"
+ }
+ } msg]
+ if {$f != ""} {
+ close $f
+ }
+ if $error {
+ error $msg $errorInfo $errorCode
+ }
+ }
+ if [info exists auto_index($cmd)] {
+ uplevel #0 $auto_index($cmd)
+ if {[info commands $cmd] != ""} {
+ return 1
+ }
+ }
+ return 0
+}
+
+if {[string compare $tcl_platform(platform) windows] == 0} {
+
+# auto_execok --
+#
+# Returns 1 if there's an executable in the current path for the
+# given name, 0 otherwise. Builds an associative array auto_execs
+# that caches information about previous checks, for speed.
+#
+# Arguments:
+# name - Name of a command.
+
+# Windows version.
+#
+# Note that info executable doesn't work under Windows, so we have to
+# look for files with .exe, .com, or .bat extensions. Also, the path
+# may be in the Path or PATH environment variables, and path
+# components are separated with semicolons, not colons as under Unix.
+#
+proc auto_execok name {
+ global auto_execs env
+
+ if [info exists auto_execs($name)] {
+ return $auto_execs($name)
+ }
+ set auto_execs($name) 0
+ if {[file pathtype $name] != "relative"} {
+ foreach ext {.exe .bat .cmd} {
+ if {[file exists ${name}${ext}]
+ && ![file isdirectory ${name}${ext}]} {
+ set auto_execs($name) 1
+ }
+ }
+ return $auto_execs($name)
+ }
+ if {! [info exists env(PATH)]} {
+ if [info exists env(Path)] {
+ set path $env(Path)
+ } else {
+ return 0
+ }
+ } else {
+ set path $env(PATH)
+ }
+ foreach dir [split $path {;}] {
+ if {$dir == ""} {
+ set dir .
+ }
+ foreach ext {.exe .bat .cmd} {
+ set file [file join $dir ${name}${ext}]
+ if {[file exists $file] && ![file isdirectory $file]} {
+ set auto_execs($name) 1
+ return 1
+ }
+ }
+ }
+ return 0
+}
+
+} else {
+
+# Unix version.
+#
+proc auto_execok name {
+ global auto_execs env
+
+ if [info exists auto_execs($name)] {
+ return $auto_execs($name)
+ }
+ set auto_execs($name) 0
+ if {[file pathtype $name] != "relative"} {
+ if {[file executable $name] && ![file isdirectory $name]} {
+ set auto_execs($name) 1
+ }
+ return $auto_execs($name)
+ }
+ foreach dir [split $env(PATH) :] {
+ if {$dir == ""} {
+ set dir .
+ }
+ set file [file join $dir $name]
+ if {[file executable $file] && ![file isdirectory $file]} {
+ set auto_execs($name) 1
+ return 1
+ }
+ }
+ return 0
+}
+
+}
+# auto_reset --
+# Destroy all cached information for auto-loading and auto-execution,
+# so that the information gets recomputed the next time it's needed.
+# Also delete any procedures that are listed in the auto-load index
+# except those related to auto-loading.
+#
+# Arguments:
+# None.
+
+proc auto_reset {} {
+ global auto_execs auto_index auto_oldpath
+ foreach p [info procs] {
+ if {[info exists auto_index($p)] && ($p != "unknown")
+ && ![string match auto_* $p]} {
+ rename $p {}
+ }
+ }
+ catch {unset auto_execs}
+ catch {unset auto_index}
+ catch {unset auto_oldpath}
+}
+
+# auto_mkindex --
+# Regenerate a tclIndex file from Tcl source files. Takes as argument
+# the name of the directory in which the tclIndex file is to be placed,
+# followed by any number of glob patterns to use in that directory to
+# locate all of the relevant files.
+#
+# Arguments:
+# dir - Name of the directory in which to create an index.
+# args - Any number of additional arguments giving the
+# names of files within dir. If no additional
+# are given auto_mkindex will look for *.tcl.
+
+proc auto_mkindex {dir args} {
+ global errorCode errorInfo
+ set oldDir [pwd]
+ cd $dir
+ set dir [pwd]
+ append index "# Tcl autoload index file, version 2.0\n"
+ append index "# This file is generated by the \"auto_mkindex\" command\n"
+ append index "# and sourced to set up indexing information for one or\n"
+ append index "# more commands. Typically each line is a command that\n"
+ append index "# sets an element in the auto_index array, where the\n"
+ append index "# element name is the name of a command and the value is\n"
+ append index "# a script that loads the command.\n\n"
+ if {$args == ""} {
+ set args *.tcl
+ }
+ foreach file [eval glob $args] {
+ set f ""
+ set error [catch {
+ set f [open $file]
+ while {[gets $f line] >= 0} {
+ if [regexp {^proc[ ]+([^ ]*)} $line match procName] {
+ append index "set [list auto_index($procName)]"
+ append index " \[list source \[file join \$dir [list $file]\]\]\n"
+ }
+ }
+ close $f
+ } msg]
+ if $error {
+ set code $errorCode
+ set info $errorInfo
+ catch {close $f}
+ cd $oldDir
+ error $msg $info $code
+ }
+ }
+ set f ""
+ set error [catch {
+ set f [open tclIndex w]
+ puts $f $index nonewline
+ close $f
+ cd $oldDir
+ } msg]
+ if $error {
+ set code $errorCode
+ set info $errorInfo
+ catch {close $f}
+ cd $oldDir
+ error $msg $info $code
+ }
+}
+
+# pkg_mkIndex --
+# This procedure creates a package index in a given directory. The
+# package index consists of a "pkgIndex.tcl" file whose contents are
+# a Tcl script that sets up package information with "package require"
+# commands. The commands describe all of the packages defined by the
+# files given as arguments.
+#
+# Arguments:
+# dir - Name of the directory in which to create the index.
+# args - Any number of additional arguments, each giving
+# a glob pattern that matches the names of one or
+# more shared libraries or Tcl script files in
+# dir.
+
+proc pkg_mkIndex {dir args} {
+ global errorCode errorInfo
+ append index "# Tcl package index file, version 1.0\n"
+ append index "# This file is generated by the \"pkg_mkIndex\" command\n"
+ append index "# and sourced either when an application starts up or\n"
+ append index "# by a \"package unknown\" script. It invokes the\n"
+ append index "# \"package ifneeded\" command to set up package-related\n"
+ append index "# information so that packages will be loaded automatically\n"
+ append index "# in response to \"package require\" commands. When this\n"
+ append index "# script is sourced, the variable \$dir must contain the\n"
+ append index "# full path name of this file's directory.\n"
+ set oldDir [pwd]
+ cd $dir
+ foreach file [eval glob $args] {
+ # For each file, figure out what commands and packages it provides.
+ # To do this, create a child interpreter, load the file into the
+ # interpreter, and get a list of the new commands and packages
+ # that are defined. Define an empty "package unknown" script so
+ # that there are no recursive package inclusions.
+
+ set c [interp create]
+ $c eval [list set file $file]
+ if [catch {
+ $c eval {
+ proc dummy args {}
+ package unknown dummy
+ set origCmds [info commands]
+ set dir "" ;# in case file is pkgIndex.tcl
+ set pkgs ""
+
+ # The "file join ." command below is necessary. Without it,
+ # if the file name has no \'s and we're on UNIX, the
+ # LD_LIBRARY_PATH search mechanism will be invoked, which
+ # could cause the wrong file to be used.
+
+ if [catch {load [file join . $file]}] {
+ if [catch {source $file}] {
+ puts $errorInfo
+ error "can't either load or source $file"
+ } else {
+ set type source
+ }
+ } else {
+ set type load
+ }
+ foreach i [info commands] {
+ set cmds($i) 1
+ }
+ foreach i $origCmds {
+ catch {unset cmds($i)}
+ }
+ foreach i [package names] {
+ if {([string compare [package provide $i] ""] != 0)
+ && ([string compare $i Tcl] != 0)} {
+ lappend pkgs [list $i [package provide $i]]
+ }
+ }
+ }
+ } msg] {
+ interp delete $c
+ error $msg $errorInfo $errorCode
+ }
+ foreach pkg [$c eval set pkgs] {
+ lappend files($pkg) [list $file [$c eval set type] \
+ [lsort [$c eval array names cmds]]]
+ }
+ interp delete $c
+ }
+ foreach pkg [lsort [array names files]] {
+ append index "\npackage ifneeded $pkg\
+ \"tclPkgSetup \$dir [lrange $pkg 0 0] [lrange $pkg 1 1]\
+ [list $files($pkg)]\""
+ }
+ set f [open pkgIndex.tcl w]
+ puts $f $index
+ close $f
+ cd $oldDir
+}
+
+# tclPkgSetup --
+# This is a utility procedure use by pkgIndex.tcl files. It is invoked
+# as part of a "package ifneeded" script. It calls "package provide"
+# to indicate that a package is available, then sets entries in the
+# auto_index array so that the package's files will be auto-loaded when
+# the commands are used.
+#
+# Arguments:
+# dir - Directory containing all the files for this package.
+# pkg - Name of the package (no version number).
+# version - Version number for the package, such as 2.1.3.
+# files - List of files that constitute the package. Each
+# element is a sub-list with three elements. The first
+# is the name of a file relative to $dir, the second is
+# "load" or "source", indicating whether the file is a
+# loadable binary or a script to source, and the third
+# is a list of commands defined by this file.
+
+proc tclPkgSetup {dir pkg version files} {
+ global auto_index
+
+ package provide $pkg $version
+ foreach fileInfo $files {
+ set f [lindex $fileInfo 0]
+ set type [lindex $fileInfo 1]
+ foreach cmd [lindex $fileInfo 2] {
+ if {$type == "load"} {
+ set auto_index($cmd) [list load [file join $dir $f] $pkg]
+ } else {
+ set auto_index($cmd) [list source [file join $dir $f]]
+ }
+ }
+ }
+}
+
+# tclPkgUnknown --
+# This procedure provides the default for the "package unknown" function.
+# It is invoked when a package that's needed can't be found. It scans
+# the auto_path directories looking for pkgIndex.tcl files and sources any
+# such files that are found to setup the package database.
+#
+# Arguments:
+# name - Name of desired package. Not used.
+# version - Version of desired package. Not used.
+# exact - Either "-exact" or omitted. Not used.
+
+proc tclPkgUnknown {name version {exact {}}} {
+ global auto_path
+
+ if ![info exists auto_path] {
+ return
+ }
+ for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {
+ set dir [lindex $auto_path $i]
+ set file [file join $dir pkgIndex.tcl]
+ if [file readable $file] {
+ source $file
+ }
+ }
+}
diff --git a/contrib/tcl/library/ldAout.tcl b/contrib/tcl/library/ldAout.tcl
new file mode 100644
index 000000000000..2e532d39b043
--- /dev/null
+++ b/contrib/tcl/library/ldAout.tcl
@@ -0,0 +1,224 @@
+# ldAout.tcl --
+#
+# This "tclldAout" procedure in this script acts as a replacement
+# for the "ld" command when linking an object file that will be
+# loaded dynamically into Tcl or Tk using pseudo-static linking.
+#
+# Parameters:
+# The arguments to the script are the command line options for
+# an "ld" command.
+#
+# Results:
+# The "ld" command is parsed, and the "-o" option determines the
+# module name. ".a" and ".o" options are accumulated.
+# The input archives and object files are examined with the "nm"
+# command to determine whether the modules initialization
+# entry and safe initialization entry are present. A trivial
+# C function that locates the entries is composed, compiled, and
+# its .o file placed before all others in the command; then
+# "ld" is executed to bind the objects together.
+#
+# SCCS: @(#) ldAout.tcl 1.9 96/04/11 10:03:24
+#
+# Copyright (c) 1995, by General Electric Company. All rights reserved.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# This work was supported in part by the ARPA Manufacturing Automation
+# and Design Engineering (MADE) Initiative through ARPA contract
+# F33615-94-C-4400.
+
+proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
+ global env
+ global argv
+
+ if {$cc==""} {
+ set cc $env(CC)
+ }
+
+ # if only two parameters are supplied there is assumed that the
+ # only shlib_suffix is missing. This parameter is anyway available
+ # as "info sharedlibextension" too, so there is no need to transfer
+ # 3 parameters to the function tclLdAout. For compatibility, this
+ # function now accepts both 2 and 3 parameters.
+
+ if {$shlib_suffix==""} {
+ set shlib_suffix $env(SHLIB_SUFFIX)
+ set shlib_cflags $env(SHLIB_CFLAGS)
+ } else {
+ if {$shlib_cflags=="none"} {
+ set shlib_cflags $shlib_suffix
+ set shlib_suffix [info sharedlibextension]
+ }
+ }
+
+ # seenDotO is nonzero if a .o or .a file has been seen
+
+ set seenDotO 0
+
+ # minusO is nonzero if the last command line argument was "-o".
+
+ set minusO 0
+
+ # head has command line arguments up to but not including the first
+ # .o or .a file. tail has the rest of the arguments.
+
+ set head {}
+ set tail {}
+
+ # nmCommand is the "nm" command that lists global symbols from the
+ # object files.
+
+ set nmCommand {|nm -g}
+
+ # entryProtos is the table of _Init and _SafeInit prototypes found in the
+ # module.
+
+ set entryProtos {}
+
+ # entryPoints is the table of _Init and _SafeInit entries found in the
+ # module.
+
+ set entryPoints {}
+
+ # libraries is the list of -L and -l flags to the linker.
+
+ set libraries {}
+ set libdirs {}
+
+ # Process command line arguments
+
+ foreach a $argv {
+ if {!$minusO && [regexp {\.[ao]$} $a]} {
+ set seenDotO 1
+ lappend nmCommand $a
+ }
+ if {$minusO} {
+ set outputFile $a
+ set minusO 0
+ } elseif {![string compare $a -o]} {
+ set minusO 1
+ }
+ if [regexp {^-[lL]} $a] {
+ lappend libraries $a
+ if [regexp {^-L} $a] {
+ lappend libdirs [string range $a 2 end]
+ }
+ } elseif {$seenDotO} {
+ lappend tail $a
+ } else {
+ lappend head $a
+ }
+ }
+ lappend libdirs /lib /usr/lib
+ lappend libraries -lm -lc
+
+ # MIPS -- If there are corresponding G0 libraries, replace the
+ # ordinary ones with the G0 ones.
+
+ set libs {}
+ foreach lib $libraries {
+ if [regexp {^-l} $lib] {
+ set lname [string range $lib 2 end]
+ foreach dir $libdirs {
+ if [file exists [file join $dir lib${lname}_G0.a]] {
+ set lname ${lname}_G0
+ break
+ }
+ }
+ lappend libs -l$lname
+ } else {
+ lappend libs $lib
+ }
+ }
+ set libraries $libs
+
+ # Extract the module name from the "-o" option
+
+ if {![info exists outputFile]} {
+ error "-o option must be supplied to link a Tcl load module"
+ }
+ set m [file tail $outputFile]
+ set l [expr [string length $m] - [string length $shlib_suffix]]
+ if [string compare [string range $m $l end] $shlib_suffix] {
+ error "Output file does not appear to have a $shlib_suffix suffix"
+ }
+ set modName [string toupper [string index $m 0]]
+ append modName [string tolower [string range $m 1 [expr $l-1]]]
+ regsub -all \\. $modName _ modName
+
+ # Catalog initialization entry points found in the module
+
+ set f [open $nmCommand r]
+ while {[gets $f l] >= 0} {
+ if [regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol] {
+ if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
+ set s $symbol
+ }
+ append entryProtos {extern int } $symbol { (); } \n
+ append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n
+ }
+ }
+ close $f
+
+ if {$entryPoints==""} {
+ error "No entry point found in objects"
+ }
+
+ # Compose a C function that resolves the initialization entry points and
+ # embeds the required libraries in the object code.
+
+ set C {#include <string.h>}
+ append C \n
+ append C {char TclLoadLibraries_} $modName { [] =} \n
+ append C { "@LIBS: } $libraries {";} \n
+ append C $entryProtos
+ append C {static struct } \{ \n
+ append C { char * name;} \n
+ append C { int (*value)();} \n
+ append C \} {dictionary [] = } \{ \n
+ append C $entryPoints
+ append C { 0, 0 } \n \} \; \n
+ append C {typedef struct Tcl_Interp Tcl_Interp;} \n
+ append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
+ append C {Tcl_PackageInitProc *} \n
+ append C TclLoadDictionary_ $modName { (symbol)} \n
+ append C { char * symbol;} \n
+ append C {{
+ int i;
+ for (i = 0; dictionary [i] . name != 0; ++i) {
+ if (!strcmp (symbol, dictionary [i] . name)) {
+ return dictionary [i].value;
+ }
+ }
+ return 0;
+}} \n
+
+ # Write the C module and compile it
+
+ set cFile tcl$modName.c
+ set f [open $cFile w]
+ puts -nonewline $f $C
+ close $f
+ set ccCommand "$cc -c $shlib_cflags $cFile"
+ puts stderr $ccCommand
+ eval exec $ccCommand
+
+ # Now compose and execute the ld command that packages the module
+
+ set ldCommand ld
+ foreach item $head {
+ lappend ldCommand $item
+ }
+ lappend ldCommand tcl$modName.o
+ foreach item $tail {
+ lappend ldCommand $item
+ }
+ puts stderr $ldCommand
+ eval exec $ldCommand
+
+ # Clean up working files
+
+ exec /bin/rm $cFile [file rootname $cFile].o
+}
diff --git a/contrib/tcl/library/license.terms b/contrib/tcl/library/license.terms
new file mode 100644
index 000000000000..3dcd816f4a3f
--- /dev/null
+++ b/contrib/tcl/library/license.terms
@@ -0,0 +1,32 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+RESTRICTED RIGHTS: Use, duplication or disclosure by the government
+is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+of the Rights in Technical Data and Computer Software Clause as DFARS
+252.227-7013 and FAR 52.227-19.
diff --git a/contrib/tcl/library/parray.tcl b/contrib/tcl/library/parray.tcl
new file mode 100644
index 000000000000..430e7ff8936d
--- /dev/null
+++ b/contrib/tcl/library/parray.tcl
@@ -0,0 +1,29 @@
+# parray:
+# Print the contents of a global array on stdout.
+#
+# SCCS: @(#) parray.tcl 1.9 96/02/16 08:56:44
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc parray {a {pattern *}} {
+ upvar 1 $a array
+ if ![array exists array] {
+ error "\"$a\" isn't an array"
+ }
+ set maxl 0
+ foreach name [lsort [array names array $pattern]] {
+ if {[string length $name] > $maxl} {
+ set maxl [string length $name]
+ }
+ }
+ set maxl [expr {$maxl + [string length $a] + 2}]
+ foreach name [lsort [array names array $pattern]] {
+ set nameString [format %s(%s) $a $name]
+ puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
+ }
+}
diff --git a/contrib/tcl/library/tclIndex b/contrib/tcl/library/tclIndex
new file mode 100644
index 000000000000..98ceff171f9c
--- /dev/null
+++ b/contrib/tcl/library/tclIndex
@@ -0,0 +1,19 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(unknown) [list source [file join $dir init.tcl]]
+set auto_index(auto_load) [list source [file join $dir init.tcl]]
+set auto_index(auto_execok) [list source [file join $dir init.tcl]]
+set auto_index(auto_execok) [list source [file join $dir init.tcl]]
+set auto_index(auto_reset) [list source [file join $dir init.tcl]]
+set auto_index(auto_mkindex) [list source [file join $dir init.tcl]]
+set auto_index(pkg_mkIndex) [list source [file join $dir init.tcl]]
+set auto_index(tclPkgSetup) [list source [file join $dir init.tcl]]
+set auto_index(tclPkgUnknown) [list source [file join $dir init.tcl]]
+set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]]